home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Amiga Plus 1995 #1
/
Amiga Plus 1995 #1.iso
/
fish-disketten
/
fish_941-950
/
d949
/
bbbbs
/
bbbbs65.lha
/
rexx
/
bbsLOCAL.rexx
< prev
next >
Wrap
OS/2 REXX Batch file
|
1993-10-31
|
166KB
|
6,039 lines
/* $VER: bbsLOCAL.rexx 6.5 © 1993 Richard Lee Stockton 7:56PM (31.10.93)
- FREELY DISTRIBUTABLE AS LONG AS THIS NOTICE REMAINS -
BBBBS.baud without the BaudBandit stuff
Will multi-task with BBBBS.baud (within limits, see docs)
THIS IS THE SYSOP'S VERSION OF BBBBS.baud FOR LOCAL USE ONLY!
*/
copyright.=''
copyright.1=STRIP(SUBSTR(SOURCELINE(1),10))
copyright.2='
from Gramma Software 21305-60th Ave West, Mountlake Terrace WA 98043-2009'
copyright.3='
ARexx portions of this software copyright 1990-93 Richard Lee Stockton'
copyright.4='- FREELY DISTRIBUTABLE as long as this notice remains -'
/* If the QuickSortPort not found then try to run setup.rexx */
IF ~show('P','QuickSortPort') THEN CALL setup.rexx()
IF ~show('P','QuickSortPort') THEN EXIT
IF SHOW('P','BBBBS_LOCAL') THEN
DO
SAY 'bbsLOCAL.rexx is already running!'
EXIT 0
END
IF SHOW('P','BBBBS') & GETCLIP('BBS_maint')~='' THEN
DO
SAY 'BBS_maint flag is set. Wait until processing is finished, then restart.'
EXIT 0
END
CALL SETCLIP('BBS_mainfiles')
CALL SETCLIP('BBS_mainusers')
CALL OPENPORT('BBBBS_LOCAL')
PARSE VERSION . . cpu .
cpu=RIGHT(cpu,2)/10
IF cpu<1 THEN cpu=1
/* BBS Directories (may be created with SETUP option) */
bbs.=''
bbs.1='Information' /* text files from sysop for the user to read */
bbs.6='Scratch'
bbs.7='BBS_HELP'
bbs.8='rexxDoors'
bbs.9='BBS_TEXT' /* text files for BBS use. WELCOME HELLO, NEW etc. */
bbs.10='FileNotes'
bbs.11='BBS_LIBS'
bbs.12='BBS_MSGS'
bbs.13='Lists'
bbs.14='Numbers' /* 1st & last messages, mail, files */
bbs.15='Usage'
bbs.16='Logs'
bbs.17='EMailFiles'
bbs.18='EMail'
bbs.19='Users'
/* VARIABLES */
bbsprefs.=0 /* start with all prefs OFF */
alpha.=''
lastread.=0
dirnum=1
linesperpage=20
sortuserflag=0
sortalphaflag=0
savefileflag=0
emailonline=-1
level=0
lastread.=0
totwrit.=0
lastbrowse=0
warnings=0
winnings=0
nonstop=0
newfilesdate=''
newpassword=''
replysubj=''
msgdir=1
menuflag=1
logonflag=1
data.=''
/* TEXT - User data structure by line */
text.=''
text.1=' Full Name'
text.2=' Street'
text.3='City, ST Zip'
text.4=' Voice Phone'
text.5=' Password'
text.6=' Protocol'
text.7='LinesPerPage'
text.8=' Preferences'
text.9=' Computer'
text.10=' Interests'
text.11='Session Time'
text.12='FirstSession'
text.13='Last Session'
text.14=' UpLoad'
text.15=' Download'
text.16=' Last File'
text.17='Ratio Email'
text.18=' Winnings'
text.19=' Usage'
text.20=' Level'
text.21='Exclude DIRS'
text.22=' Msgs Read'
text.23=' Msgs Writ'
text.24=' Marked Msgs'
text.25='Marked Files'
text.26='QUICKexclude'
text.27=' CBV numbers'
/* try to trap everything */
SIGNAL ON BREAK_C
OPTIONS RESULTS
OPTIONS FAILAT 999999
SIGNAL ON BREAK_E
SIGNAL ON SYNTAX
SIGNAL ON FAILURE
NUMERIC DIGITS 14
ARG option .
SAY CENTER(copyright.1,75)
CALL config()
IF ~EXISTS(bbspath'Numbers/FirstLogon') THEN
ADDRESS COMMAND 'C:Date >'bbspath'Numbers/FirstLogon'
SAY CENTER(copyright.2,75)
SAY CENTER(copyright.3,75)
SAY CENTER(copyright.4,75)
SAY
IF option='SETUP' THEN
DO
SAY 'Making sure all needed directories are here...'
DO i=1 TO 20
IF bbs.i~='' THEN CALL MAKEDIR(bbspath||bbs.i)
END
END
CALL colors(1)
msg.=''
IF readopen(bbspath'Lists/Conferences') THEN
DO
DO i=1
line=READLN(f)
IF line='END' THEN BREAK
IF EOF(f) THEN BREAK
num=WORD(line,1)
IF DATATYPE(num,'W') THEN msg.num=WORD(line,2)
END
CALL CLOSE(f)
END
IF option='SETUP' THEN
DO
DO i=1 TO 99
IF msg.i~='' THEN CALL MAKEDIR(msgpath||i)
END
END
courtesy=''
IF EXISTS(bbspath'Lists/Courtesy') THEN
DO
IF readopen(bbspath'Lists/Courtesy') THEN
DO
DO i=1
line=READLN(f)
IF EOF(f) THEN BREAK
courtesy=courtesy line
END
CALL CLOSE(f)
END
END
dirs.=''
IF readopen(bbspath'Lists/Libraries') THEN
DO
DO i=1
line=READLN(f)
IF line='END' | EOF(f) THEN LEAVE i
num=WORD(line,1)
IF DATATYPE(num,'W') THEN dirs.num=STRIP(WORD(line,2))
END
CALL CLOSE(f)
END
IF option='SETUP' THEN
DO
SAY 'Making sure all file library directories are here...'
DO i=1 TO 99
IF dirs.i~='' THEN
DO
CALL MAKEDIR(libpath||dirs.i)
CALL MAKEDIR(bbspath'FileNotes/'dirs.i)
END
END
END
CALL loaduserlist()
SAY ' The larger the BBS gets, the longer the setup takes...'
files.=''
IF readopen(bbspath'Lists/Files') THEN
DO
DO i=1
line=READLN(f)
IF EOF(f) THEN BREAK
num=WORD(line,1)
IF DATATYPE(num,'W') THEN files.num=WORD(line,2) WORD(line,3)
END
files.0=i-1
CALL CLOSE(f)
END
IF readopen(bbspath'Lists/Files.ALPHA') THEN
DO
DO i=1
line=READLN(f)
IF EOF(f) THEN BREAK
alpha.i=line
fnum=WORD(line,3)
files.fnum.0=i
END
alpha.0=i-1
CALL CLOSE(f)
END
CALL set_grand()
BIG_LOOP:
/** Identify (title) message */
IF EXISTS(bbspath'BBS_TEXT/HELLO') THEN
DO
SAY
arg=bbspath'BBS_TEXT/HELLO'
CALL readlines(arg 1)
CALL seelines(0)
END
SAY
SAY pen3'Courtesy List:'def
SAY courtesy
SAY
/* Ask for name */
name=''
DO count=1 TO 3
name=getinput(1 0 'Please enter name: ')
name=SPACE(name,1,'_')
IF name='NEW' THEN LEAVE count
IF name~='' THEN
DO
IF FIND(userlist,name)>0 THEN LEAVE count
IF FIND(exclusion,name)>0 THEN
DO
SAY 'Sorry, that is a reserved name.'
name=''
ITERATE count
END
IF bbsprefs.7>0 | FIND(courtesy,name)>0 THEN
DO
SAY
SAY 'Welcome' name'!'
SAY 'You will be automatically validated after you enter your user info.'
SAY
LEAVE count
END
END
IF count<3 THEN SAY 'New Users please enter NEW to apply for validation.'
END
IF count>3 THEN SIGNAL DONE
CALL checkUser()
IF UPPER(WORD(data.12,3))~='BIRTHDAY:' THEN
DO
SAY
SAY 'Please help us out by entering the following information.'
CALL getbirth()
SAY ' Thank you!'
END
CALL checkclips()
city=docity(data.3)
CALL TIME('R')
IF RIGHT(WORD(data.12,4),4)=RIGHT(DATE('S'),4) THEN
DO
arg=bbspath'BBS_TEXT/BIRTHDAY'
IF EXISTS(arg) THEN
DO
SAY
CALL showtext(arg)
END
SAY
SAY '*** Happy Birthday,' pen3||data.1||def', and many more! ***'
SAY
END
SAY
CALL bbsLOGON.baud(name level)
CALL sortlibraries()
IF FIND(data.8,'QUICK')>0 THEN CALL do_quick(0)
/* Opening Display after logon. Seen by all Users ONCE A DAY. It first */
/* looks for a unique yearly data (ie, WELCOME.0704), then daily data */
/* (ie, WELCOME.Fri), and finally a simple, everyday 'WELCOME' datafile */
IF DATE('I')>lastondate THEN
DO
SAY
arg=bbspath'BBS_TEXT/WELCOME.'RIGHT(DATE('S'),4)
IF EXISTS(arg) THEN CALL showtext(arg)
SAY
arg=bbspath'BBS_TEXT/WELCOME.'LEFT(DATE('W'),3)
IF EXISTS(arg) THEN CALL showtext(arg)
SAY
arg=bbspath'BBS_TEXT/WELCOME'
IF EXISTS(arg) THEN CALL showtext(arg)
/*
Looks for format UNTIL.YYYYMMDD ie, "UNTIL.19920514"
Deletes any that are previous to "today"
*/
untils.=''
IF FileList(bbspath'BBS_TEXT/UNTIL.*',untils)>0 THEN
DO
CALL QSORT(1,untils.0,untils)
DO ui=1 TO untils.0
IF RIGHT(untils.ui,8)<DATE('S') THEN CALL DELETE(untils.ui)
ELSE
DO
SAY
CALL showtext(untils.ui)
END
END
END
DROP untils.
END
IF bbsprefs.1 & ~terseflag THEN
DO
IF doGrin()>3 THEN CALL waiting()
IF EXISTS(bbspath'rexxDoors/Moon.rexx') THEN CALL Moon.rexx()
IF EXISTS(bbspath'rexxDoors/Time.rexx') THEN CALL Time.rexx()
IF FIND(UPPER(SHOWLIST('A')),'TODAY')>0 THEN
DO
IF EXISTS('RAM:TODAY') THEN
DO
finfo=STATEF('RAM:TODAY')
IF WORD(finfo,5)~=DATE('I') THEN
ADDRESS COMMAND 'C:Today091 >RAM:TODAY'
END
ELSE ADDRESS COMMAND 'C:Today091 >RAM:TODAY'
IF EXISTS('RAM:TODAY') THEN
DO
CALL readlines('RAM:TODAY' 1)
CALL seelines(0)
END
END
SAY
END
CALL readmail(0)
IF ~terseflag THEN
DO
IF level>sysoplevel THEN
DO
lstmail=WORD(data.17,3)
IF ~DATATYPE(lstmail,'W') THEN lstmail=0
IF countcheck(bbspath'Numbers/LastMail' 0)>lstmail THEN
IF getinput(1 1 'Check Email? (Ny) > ')='Y' THEN CALL mailreport()
IF level<99 THEN
DO
SAY
CALL showtext(bbspath'Email/'sysop'/NEW_FILES')
END
SAY
CALL showtext(bbspath'Lists/NEW_USERS')
CALL showtext(bbspath'Lists/CBV_USERS')
END
CALL logonstats()
CALL newinfo()
END
CALL showmarked(1)
CALL setdir(libpath||dirs.1)
logonflag=0
/***** MAIN *****/
IF menu~='ALL' THEN menu='MAIN'
RESTART:
SIGNAL ON BREAK_C
SIGNAL ON BREAK_E
waitchar=''
string=''
opt=''
IF level<1 THEN menu='NEW'
DO WHILE(opt~='G')
go=0
DO WHILE(~go)
IF waitchar='' | waitchar='?' THEN
DO
commands='cghiqsvwxyz!#,'
IF level>0 THEN commands='abcdefghijlmnoprstuvwxyz!$#&.,+'
IF level>sysoplevel THEN commands=commands'k%^()=;'
IF level=99 THEN commands=commands'@~'
commands=commands'?'
IF menuflag | waitchar='?' | string='?' THEN
DO
opt='MENU'
arg=''
CALL menus()
END
ELSE SAY pen3'COMMANDS:'def commands
END
line=''
line=line||bak2' 'TIME('C')' 'def
IF menu='ALL' | menu='FILE' THEN
line=line pen3'FILE_LIBRARY:'plaindir||def
ELSE IF menu='MSG' THEN line=line pen3'MESSAGES:'def
ELSE line=line pen3'MAIN:'def
line=line' 'bbsname
IF waitchar='' THEN waitchar=getinput(0 0 line' > ')
PARSE VAR waitchar string' 'arg
nonstop=0
string=UPPER(STRIP(string))
IF string='OFF' | string='BYE' THEN SIGNAL LOGOUT
IF string='FL' & level>0 THEN CALL Friends()
CALL checkalias()
waitchar=''
IF DATATYPE(string,'W') THEN
DO
IF string>level THEN
DO
arg=STRIP(string arg)
string='D'
END
ELSE
DO
dirnum=string
CALL chdir2()
CALL since()
END
END
IF string='QUICK' & level>0 THEN CALL do_quick(1)
opt=left(string,1)
go=1
IF POS(opt,UPPER(commands))=0 THEN go=0
END
OPTIONS PROMPT 'Filename: '
SELECT
WHEN opt='A' THEN CALL showalpha()
WHEN opt='B' THEN CALL browse()
WHEN opt='C' THEN CALL editor('MAIL' sysop)
WHEN opt='D' THEN CALL dload()
WHEN opt='E' THEN CALL readmail(1)
WHEN opt='F' THEN CALL do_F()
WHEN opt='H' THEN CALL help('MAIN')
WHEN opt='I' THEN CALL information()
WHEN opt='J' THEN CALL jump2rexx()
WHEN opt='K' THEN CALL killuser()
WHEN opt='L' THEN CALL list()
WHEN opt='M' THEN IF menu~='ALL' THEN menu='MSG'
WHEN opt='N' THEN CALL newfiles()
WHEN opt='O' THEN CALL otheruser()
WHEN opt='P' THEN CALL editor('MSG')
WHEN opt='R' THEN CALL readmessages()
WHEN opt='S' THEN CALL bbsSEARCH()
WHEN opt='U' THEN CALL uload(1)
WHEN opt='V' THEN CALL showtext(bbspath'Usage/USER.LOG')
WHEN opt='W' THEN CALL showuserlist()
WHEN opt='X' THEN CALL switchmenuflag()
WHEN opt='Y' THEN CALL edituser()
WHEN opt='Z' THEN CALL counts()
WHEN opt='~' THEN CALL sysED(1)
WHEN opt='@' THEN CALL shell()
WHEN opt='#' THEN CALL switchcolors()
WHEN opt='$' THEN IF menu='ALL' THEN menu='MAIN'; ELSE menu='ALL'
WHEN opt='%' THEN CALL editnote()
WHEN opt='^' THEN CALL readlogs()
WHEN opt='&' THEN CALL profiles()
WHEN opt=';' THEN CALL changename()
WHEN opt='(' THEN CALL filereport()
WHEN opt=')' THEN CALL mailreport()
WHEN opt='=' THEN CALL levelreport()
WHEN opt='+' THEN CALL ext_dload()
WHEN opt='.' THEN menu='MAIN'
WHEN opt=',' THEN DO;CALL hourly();CALL waiting();END
WHEN opt='?' & menuflag THEN CALL help('MAIN')
OTHERWISE NOP
END
END
SIGNAL LOGOUT
EXIT
/* FUNCTIONS */
do_F:
IF menu='FILE' | menu='ALL' THEN
DO
IF STORAGE()<(bbsprefs.15+100000) | GETCLIP('BBS_libs.0')~='' THEN
DO
SAY
SAY 'Sorry! Not enough memory left for background archiving.'
SAY 'Please try again in 10 minutes or so.'
SAY
RETURN
END
DO i=0 TO libs.0
CALL SETCLIP('BBS_libs.'i,libs.i)
END
IF Make_BrowseList.baud(name colorflag files.0)=0 THEN
IF emailonline>=0 THEN emailonline=emailonline+1
DO i=0 TO libs.0
CALL SETCLIP('BBS_libs.'i)
END
END
ELSE IF menu~='ALL' THEN menu='FILE'
RETURN
cleanstring:
PARSE ARG nflag':'cstr
bot=TRIM(XRANGE(,' '))
bot=COMPRESS(bot,'1B'x) /* ESC for ANSI */
top=XRANGE('7F'x)
IF nflag=1 THEN
DO
bot=bot||XRANGE('!','@')'[\]`~{:}'
cstr=TRANSLATE(UPPER(cstr),' ','_')
END
cstr=COMPRESS(cstr,bot||top)
IF nflag~=2 THEN cstr=STRIP(cstr)
IF nflag=1 THEN cstr=SPACE(cstr,1,'_')
RETURN cstr
showtext:
PARSE ARG arg .
IF EXISTS(arg) THEN
DO
CALL readlines(arg 1)
CALL seelines(1)
nonstop=0
CALL waiting()
END
RETURN
doGrin:
IF ~EXISTS(bbspath'rexxDoors/Grin_du_Jour.rexx') THEN RETURN 0
CALL setdir(bbspath'rexxDoors')
temp=Grin_du_Jour.rexx()
SAY
RETURN temp
do_quick:
ARG flag .
IF FIND(UPPER(data.8),'QUICK')=0 THEN
DO
SAY
SAY 'The QUICK option is OFF in your current settings.'
SAY
SAY 'Setting the QUICK option to ON will allow you to tell the BBS to'
SAY 'make a .lha archive of all new bbs activity since your last call.'
SAY
SAY 'This archive can then be read (and replied to, and files can be'
SAY 'uploaded and downloaded) using 'pen3'bbsQUICK.rexx'def', the offline read/reply'
SAY 'module for BBBBS, which is available here in the file libraries.'
SAY
IF getinput(1 1 'Turn the QUICK option ON? (Ny) > ')~='Y' THEN RETURN
data.8=data.8 'QUICK'
CALL saveData(0)
END
ELSE IF flag=1 THEN
DO
IF getinput(1 1 'Turn the QUICK option OFF? (Ny) > ')='Y' THEN
DO
temp=data.8
data.8=''
DO i=1 TO WORDS(temp)
IF WORD(temp,i)~='QUICK' THEN data.8=STRIP(data.8 WORD(temp,i))
END
ADDRESS COMMAND 'c:delete' bbspath'EmailFiles/'name'/QUICK_#?'
RETURN
END
END
IF getinput(1 1 'Edit your QUICK exclude list? (Ny) > ')='Y' THEN
DO
SAY
SAY 'You may EXCLUDE any of these from your QUICK archives.'
SAY pen3||LEFT('-',74,'-')||def
temp=LEFT(' ',7)
SAY temp'HELLO - Pre-logon message.'
SAY temp'WELCOME - Post-logon message.'
SAY temp'GOODBYE - Logoff message.'
SAY temp'HOURLY - Average-Minutes-Per-Hour usage graph.'
SAY temp'STATS.BBS - Most of the Z command from the main menu.'
SAY temp'filename - ANY filename in the Information area.'
SAY temp'MESSAGES - New conference messages.'
SAY temp'FILELIST - New file descriptions.'
SAY pen3||LEFT('-',74,'-')||def
SAY 'Enter a space separated list of what you wish to exclude.'
SAY pen3'Exclude:'def data.26
temp=getinput(1 0 pen3'Exclude: 'def)
IF temp='' & data.26~='' THEN
DO
IF getinput(1 1 'Clear the QUICK exclude list? (nY) > ')~='N' THEN
data.26=''
END
ELSE data.26=temp
temp='Your QUICK archives will exclude'pen3
IF data.26='' THEN temp=temp 'nothing!'
ELSE temp=temp data.26
SAY temp||def
CALL savedata(0)
SAY
END
IF GETCLIP('BBS_'name)~='' THEN
DO
SAY
SAY 'The QUICK routines are still working on your archive...'
SAY 'Please try again later.'
SAY
RETURN
END
quickdir=bbspath'EmailFiles/'name
CALL MAKEDIR(quickdir)
CALL setdir(quickdir)
IF getinput(1 1 'Do you have a QUICKIN file to upload? (Ny) > ')='Y' THEN
DO
arg='QUICKIN.lha'
ul=2
DO WHILE ul=2
ul=uload(0)
END
END
IF EXISTS(bbspath'EmailFiles/'name'/QUICKIN.lha') & level>=sysoplevel THEN
IF getinput(1 1 'Process your QUICKIN archive [N]ow or at [L]ogoff? (Ln) > ')='N' THEN
DO
SAY
SAY 'Please wait, processing QUICKIN archive...'
CALL bbsQUICKIN.rexx(name level sysoplevel bbsprefs.6)
CALL checkclips()
CALL loadData()
SAY
END
IF GETCLIP('BBS_'name)='QUICK' THEN
DO
SAY
SAY 'The QUICK routines are still working on your file(s)...'
SAY
RETURN
END
arg='RAM:dirlist'
ADDRESS COMMAND 'C:list >'arg quickdir'/QUICK_#? DATES'
IF WORD(STATEF(arg),2)>80 THEN
DO
CALL readlines(arg 1)
CALL seelines(0)
SAY
END
efiles=UPPER(SHOWDIR(quickdir))
DO qi=1 TO WORDS(efiles)
qarg=WORD(efiles,qi)
IF LEFT(qarg,6)='QUICK_' & RIGHT(qarg,4)='.LHA' THEN
DO
SAY qarg 'is' WORD(STATEF(qarg),2) 'bytes.'
arg=qarg
DO WHILE dload()=1
END
t=''
DO WHILE t~='N' & t~='Y'
t=getinput(1 1 'Delete' qarg'? (ny) > ')
END
IF t='Y' THEN
DO
IF DELETE(quickdir'/'qarg)=1 THEN SAY qarg 'deleted.'
CALL DELETE(quickdir'/'qarg'.xdl')
qarg=COMPRESS(UPPER(qarg),'QUICK_.LHA')
CALL DELETE(bbspath'Email/'name'/BBBBS.'qarg)
END
END
END
arg=''
SAY
IF GETCLIP('BBS_'name)~='' THEN RETURN
IF getinput(1 1 'Archive new BBS activity now? (Ny) > ')='Y' THEN
DO
CALL SETCLIP('BBS_city',city)
CALL SETCLIP('BBS_'name'_26',data.26)
IF FIND(UPPER(data.26),'STATS.BBS')=0 THEN
CALL SETCLIP('BBS_statsarg',emailonline grand grand2 files.0)
IF FIND(UPPER(data.26),'MESSAGES')=0 THEN
CALL SETCLIP('BBS_'name'_22',data.22)
CALL MAKEDIR(bbspath'EmailFiles/'name)
CALL showmarked(0)
ADDRESS AREXX bbsQUICKOUT.rexx name level lastbrowse WORD(data.16,2) data.21
IF FIND(UPPER(data.26),'MESSAGES')=0 THEN
DO
clear_marked=1
DO i=1 TO level
IF WORD(data.22,i)~=-1 THEN
lastread.i=countcheck(bbspath'Numbers/LastMessage'i 0)
END
SAY
END
IF FIND(UPPER(data.26),'FILELIST')=0 THEN
lastbrowse=countcheck(bbspath'Numbers/LastFile' 0)
newfilesdate=DATE('S') TIME()
IF writeopen(bbspath'EmailFiles/'name'/Libraries') THEN
DO
DO i=1 TO libs.0
CALL WRITELN(f,libs.i)
END
CALL CLOSE(f)
END
IF writeopen(bbspath'EmailFiles/'name'/Conferences') THEN
DO
DO i=1 TO msgs.0
CALL WRITELN(f,msgs.i)
END
CALL CLOSE(f)
END
SAY
IF getinput(1 1 'Logoff Now? (nY) > ')~='N' THEN
DO
SAY 'Your archive will be waiting next time you call...'
SAY
SIGNAL LOGOUT2
END
SAY
SAY 'Note: You now have no ''new'' files or messages (they are being archived).'
SAY
CALL saveData(1)
CALL waiting()
END
ELSE
DO
SAY
IF getinput(1 1 'Logoff Now? (nY) > ')~='N' THEN SIGNAL LOGOUT2
END
SAY
RETURN
killuser:
IF level<=sysoplevel THEN RETURN
killcount=0
DO loop=1
IF arg='' THEN
DO
OPTIONS PROMPT 'RETURN=QUIT Username to Kill: '
PULL arg
END
IF STRIP(arg)='' THEN LEAVE loop
arg=UPPER(arg)
arg=SPACE(STRIP(arg),1,'_')
IF getinput(1 1 'Really kill' arg'? (nY) > ')='N' THEN
DO
arg=''
ITERATE loop
END
SAY 'Working...'
IF readlines(bbspath'Users/'arg 1) THEN
DO
SAY 'User' arg 'not found.'
arg=''
ITERATE loop
END
IF level<=lynes.20 THEN
DO
SAY '*** Tsk! Tsk! Your level is not greater than' arg'.'
arg=''
ITERATE loop
END
CALL DELETE(bbspath'Users/'arg)
IF EXISTS(bbspath'Email/'arg) THEN
DO
temp=WORDS(SHOWDIR(bbspath'Email/'arg))
emailonline=emailonline-temp
ADDRESS COMMAND 'C:DELETE >*' bbspath'Email/'arg 'ALL'
END
IF EXISTS(bbspath'EmailFiles/'arg) THEN
ADDRESS COMMAND 'C:DELETE >*' bbspath'EmailFiles/'arg 'ALL'
SAY 'User file, Email & EmailFiles for' arg 'have been deleted.'
killcount=killcount+1
arg=''
END
IF killcount=0 THEN RETURN
CALL DELETE(bbspath'Lists/USERS')
sortuserflag=1
RETURN
menus:
SAY
IF menu='NEW' THEN
DO
SAY pen6' _________________'def
SAY pen6' __/ 'pen3'New User Menu'pen6' \___'def
SAY pen6' | |'def
SAY pen6' |'def' ['pen3'H'def']elp 'pen6'|'def
SAY pen6' |'def' ['pen3'I'def']nformation 'pen6'|'def
SAY pen6' |'def' ['pen3'Y'def']our user data 'pen6'|'def
SAY pen6' |'def' ['pen3'W'def']ho is here 'pen6'|'def
SAY pen6' |'def' ['pen3'S'def']earch user list 'pen6'|'def
SAY pen6' |'def' ['pen3'V'def']iew user log 'pen6'|'def
SAY pen6' |'def' ['pen3'Z'def'] bbs statistics 'pen6'|'def
SAY pen6' |'def' ['pen3','def'] hourly stats 'pen6'|'def
SAY pen6' |'def' ['pen3'X'def'] toggle menus 'pen6'|'def
SAY pen6' |'def' ['pen3'#'def'] toggle color 'pen6'|'def
SAY pen6' |'def' ['pen3'!'def'] YELL for SYSOP 'pen6'|'def
SAY pen6' |'def' ['pen3'C'def']omment to SYSOP 'pen6'|'def
SAY pen6' |'def' ['pen3'G'def']oodbye (hangup) 'pen6'|'def
SAY pen6' |________________________|'def
END
ELSE IF menu='MSG' THEN
DO
SAY pen6' ____________'def
SAY pen6' ____/ 'pen3'Messages'pen6' \_____'def
SAY pen6' | |'def
SAY pen6' |'def' ['pen3'H'def']elp 'pen6'|'def
SAY pen6' |'def' ['pen3'P'def']ost messages 'pen6'|'def
SAY pen6' |'def' ['pen3'R'def']ead messages 'pen6'|'def
SAY pen6' |'def' ['pen3'S'def']earch messages 'pen6'|'def
SAY pen6' |'def' ['pen3'E'def']mail (private) 'pen6'|'def
SAY pen6' |'def' ['pen3'C'def']omment to SYSOP 'pen6'|'def
SAY pen6' |'def' ['pen3'QUICK'def'] options 'pen6'|'def
SAY pen6' |'def' ['pen3'FL'def'] Friends List 'pen6'|'def
SAY pen6' |'def' ['pen3'!'def'] YELL for SYSOP 'pen6'|'def
IF(level>sysoplevel) THEN DO
SAY pen6' |'def' ['pen3'^'def'] view BBS logs 'pen6'|'def
SAY pen6' |'def' ['pen3')'def'] email report 'pen6'|'def
SAY pen6' |'def' ['pen3'='def'] level report 'pen6'|'def
SAY pen6' |'def' ['pen3';'def'] change username 'pen6'|'def;END
IF(level=99) THEN DO
SAY pen6' |'def' ['pen3'~'def'] online editor 'pen6'|'def
SAY pen6' |'def' ['pen3'@'def'] dos shell 'pen6'|'def;END
SAY pen6' |'def' ['pen3'F'def']iles menu 'pen6'|'def
SAY pen6' |'def' ['pen3'.'def'] main menu 'pen6'|'def
SAY pen6' |_______________________|'def
END
ELSE IF menu='FILE' THEN
DO
SAY pen6' _________'def
SAY pen6' ______/ 'pen3'Files'pen6' \_______'def
SAY pen6' | |'def
SAY pen6' |'def' ['pen3'A'def']lphabetic list 'pen6'|'def
SAY pen6' |'def' ['pen3'H'def']elp 'pen6'|'def
SAY pen6' |'def' ['pen3'B'def']rowse filenotes 'pen6'|'def
SAY pen6' |'def' ['pen3'N'def']ew files list 'pen6'|'def
SAY pen6' |'def' ['pen3'L'def']ist by Library 'pen6'|'def
SAY pen6' |'def' ['pen3'F'def']ilelist archives 'pen6'|'def
SAY pen6' |'def' ['pen3'S'def']earch files 'pen6'|'def
SAY pen6' |'def' ['pen3'U'def']pload 'pen6'|'def
SAY pen6' |'def' ['pen3'D'def']ownload 'pen6'|'def
SAY pen6' |'def' ['pen3'+'def'] Extra Devices 'pen6'|'def
IF(level>sysoplevel) THEN DO
SAY pen6' |'def' ['pen3'K'def']ill a user 'pen6'|'def
SAY pen6' |'def' ['pen3'%'def'] edit filenote 'pen6'|'def
SAY pen6' |'def' ['pen3'('def'] file report 'pen6'|'def
SAY pen6' |'def' ['pen3';'def'] change username 'pen6'|'def;END
IF(level=99) THEN
SAY pen6' |'def' ['pen3'@'def'] dos shell 'pen6'|'def
SAY pen6' |'def' ['pen3'M'def']essages menu 'pen6'|'def
SAY pen6' |'def' ['pen3'.'def'] main menu 'pen6'|'def
SAY pen6' |________________________|'def
END
ELSE IF menu='MAIN' THEN
DO
SAY pen6' _____________'def
SAY pen6' ____/ 'pen3'Main Menu'pen6' \_____'def
SAY pen6' | |'def
SAY pen6' |'def' ['pen3'H'def']elp 'pen6'|'def
SAY pen6' |'def' ['pen3'I'def']nfomation 'pen6'|'def
SAY pen6' |'def' ['pen3'J'def']ump to doorways 'pen6'|'def
SAY pen6' |'def' ['pen3'Y'def']our user data 'pen6'|'def
SAY pen6' |'def' ['pen3'W'def']ho is here list 'pen6'|'def
SAY pen6' |'def' ['pen3'S'def']earch userlist 'pen6'|'def
SAY pen6' |'def' ['pen3'O'def']ther users info 'pen6'|'def
SAY pen6' |'def' ['pen3'V'def']iew user log 'pen6'|'def
SAY pen6' |'def' ['pen3'X'def']pert (no menus) 'pen6'|'def
SAY pen6' |'def' ['pen3'#'def'] toggle colors 'pen6'|'def
SAY pen6' |'def' ['pen3'$'def'] toggle menu(s) 'pen6'|'def
SAY pen6' |'def' ['pen3'&'def'] user profiles 'pen6'|'def
SAY pen6' |'def' ['pen3'Z'def'] bbs statistics 'pen6'|'def
SAY pen6' |'def' ['pen3','def'] hourly stats 'pen6'|'def
SAY pen6' |'def' ['pen3'G'def']oodbye (hangup) 'pen6'|'def
SAY pen6' |'def' ['pen3'F'def']iles menu 'pen6'|'def
SAY pen6' |'def' ['pen3'M'def']essages menu 'pen6'|'def
SAY pen6' |________________________|'def
END
ELSE IF menu='ALL' THEN
DO
SAY pen6' __________________________________________________________'def
SAY pen6' __/ 'pen3'Main Menu File Menu Message Menu 'pen6' \__'def
SAY pen6' | |'def
SAY pen6' |'def' ['pen3'H'def']elp ['pen3'A'def']lphabetical list ['pen3'P'def']ost messages 'pen6'|'def
SAY pen6' |'def' ['pen3'I'def']nformation ['pen3'B'def']rowse filenotes ['pen3'R'def']ead messages 'pen6'|'def
SAY pen6' |'def' ['pen3'Z'def'] bbs statiZtics ['pen3'L'def']ist by Library ['pen3'E'def']mail (private) 'pen6'|'def
SAY pen6' |'def' ['pen3'Y'def']our user data ['pen3'N'def']ew files ['pen3'C'def']omment to SYSOP 'pen6'|'def
SAY pen6' |'def' ['pen3'O'def']ther users info ['pen3'F'def']ilelist archiver ['pen3'!'def'] YELL for SYSOP 'pen6'|'def
SAY pen6' |'def' ['pen3'J'def']ump to doorways ['pen3'+'def'] Extra Devices ['pen3'X'def']pert (no menus) 'pen6'|'def
SAY pen6' |'def' ['pen3'S'def']earch menu ['pen3'D'def']ownload ['pen3'$'def'] toggle menu(s) 'pen6'|'def
SAY pen6' |'def' ['pen3'&'def'] user profiles ['pen3'U'def']pload ['pen3'#'def'] toggle colors 'pen6'|'def
SAY pen6' |'def' ['pen3'V'def']iew user log ['pen3'T'def']ransfer protocol ['pen3','def'] hourly stats 'pen6'|'def
SAY pen6' |'def' ['pen3'G'def']oodbye (logoff) ['pen3'QUICK'def'] options ['pen3'FL'def'] Friends List 'pen6'|'def
IF(level>sysoplevel) THEN DO
SAY pen6' |'def' ['pen3'K'def']ill a user ['pen3'%'def'] edit filenote ['pen3'='def'] level report 'pen6'|'def
SAY pen6' |'def' ['pen3'^'def'] view BBS logs ['pen3'('def'] file report ['pen3';'def'] change username 'pen6'|'def;END
IF(level=99) THEN
SAY pen6' |'def' ['pen3'~'def'] online editor ['pen3'@'def'] dos shell ['pen3')'def'] email report 'pen6'|'def
SAY pen6' |________________________________________________________________|'def
END
SAY
RETURN
help:
ARG helppath .
SAY
SAY 'For more detailed help, use ['pen3'I'def']nformation commmand to read BBBBS.COMMANDS.'
IF helppath='MAIN' THEN
SAY 'Commands available from the' pen3||menu||def 'menu:'
frontend=bbspath'BBS_HELP/'helppath
backend='.USER'
IF level=0 THEN backend='.NEW'
ELSE IF level=99 THEN backend='.SUPER'
ELSE IF level>sysoplevel THEN backend='.SYSOP'
CALL showtext(frontend||backend)
RETURN
waiting:
IF waitchar='Q' THEN
DO
waitchar=''
RETURN
END
waitchar=''
IF nonstop=1 THEN RETURN
OPTIONS PROMPT pen3' RETURN=Continue 'def
PULL waitchar
CALL cleanline(1)
RETURN
waiting2:
IF nonstop=1 THEN RETURN 0
waitchar=getinput(1 1 pen3' Q=Quit N=Non-Stop RETURN=Continue 'def)
IF waitchar='N' THEN
DO
nonstop=1
SAY pen3'To EXIT non-stop scrolling of text, press CTRL-E 'def
SAY
CALL DELAY(100)
waitchar=''
END
CALL cleanline(1)
IF waitchar='Q' THEN RETURN 1
RETURN 0
busywait:
ARG bii bi bt
IF bbsprefs.21=0 THEN RETURN
IF bi<1 THEN
DO
CALL WRITECH(STDOUT,'080808'x)
RETURN
END
IF bi=1 THEN CALL WRITECH(STDOUT,' ')
IF bi//(bii%2)~=0 THEN RETURN
b=bi//bii
IF b=0 | b=bii%2 THEN
DO
tp=RIGHT((bi*100)%bt,2)'%'
CALL WRITECH(STDOUT,'080808'x||tp)
END
RETURN
cleanline:
ARG lflag .
IF colorflag~=1 & lflag=1 THEN RETURN
cline=lineup||LEFT(' ',77)
IF lflag=1 THEN cline=cline||lineup
SAY cline
RETURN
getinput:
PARSE ARG upflag' 'oneflag' 'pline
OPTIONS PROMPT pline
PARSE PULL inarg
inarg=STRIP(inarg)
IF upflag THEN inarg=UPPER(inarg)
IF oneflag THEN inarg=LEFT(inarg,1)
RETURN inarg
docity:
PARSE ARG citi
citi=TRANSLATE(citi,' ','+-.,*/()<>')
DO i=WORDS(citi) TO 1 BY -1
IF DATATYPE(WORD(citi,i),'N') THEN citi=STRIP(DELWORD(citi,i,1))
IF UPPER(WORD(citi,i))='USA' THEN citi=STRIP(DELWORD(citi,i,1))
END
citi=SPACE(citi,1)
RETURN STRIP(citi)
setdir:
PARSE ARG tempdir
CALL PRAGMA('D',STRIP(tempdir))
directory=PRAGMA('D')
slash=LASTPOS('/',directory)
IF slash=0 THEN slash=LASTPOS(':',directory)
plaindir=directory
IF slash>0 THEN plaindir=SUBSTR(plaindir,slash+1)
RETURN
config:
arg='s:CONFIG.BBS'
IF ~EXISTS(arg) THEN arg='BBS:BBS_TEXT/CONFIG.BBS'
IF readlines(arg 1) THEN
DO
SAY 's:CONFIG.BBS and BBS:BBS_TEXT/CONFIG.BBS are both missing!'
SIGNAL DONE2
END
compos=POS('/*',lynes.1)
IF compos>0 THEN lynes.1=LEFT(lynes.1,compos-1)
bbsname=STRIP(lynes.1)
sysop=WORD(lynes.2,1)
compos=POS('/*',lynes.3)
IF compos>0 THEN lynes.3=LEFT(lynes.3,compos-1)
exclusion=STRIP(lynes.3)
bbsdevice=WORD(lynes.4,1)
sysoplevel=WORD(lynes.5,1)
bbspath=WORD(lynes.6,1)
IF ~EXISTS(bbspath) THEN
DO
SAY bbspath 'does not exist!'
SIGNAL DONE2
END
testchar=RIGHT(bbspath,1)
IF testchar~='/' & testchar~=':' THEN bbspath=bbspath'/'
CALL SETCLIP('BBS_path',bbspath)
msgpath=WORD(lynes.7,1)
IF ~EXISTS(msgpath) THEN
DO
SAY msgpath 'does not exist!'
SIGNAL DONE2
END
testchar=RIGHT(msgpath,1)
IF testchar~='/' & testchar~=':' THEN msgpath=msgpath'/'
CALL SETCLIP('BBS_msgpath',msgpath)
msgpath=msgpath'MSG'
libpath=WORD(lynes.8,1)
IF ~EXISTS(libpath) THEN
DO
SAY libpath 'does not exist!'
SIGNAL DONE2
END
testchar=RIGHT(libpath,1)
IF testchar~='/' & testchar~=':' THEN libpath=libpath'/'
CALL SETCLIP('BBS_libpath',libpath)
extdevs=''
DO i=1 TO WORDS(lynes.10)
test=WORD(lynes.10,i)
IF POS(':',test)=0 THEN ITERATE i
IF LEFT(test,2)='/*' THEN LEAVE i
extdevs=STRIP(extdevs test)
END
SYSTEM_MSG_LIMIT=WORD(lynes.11,1)
SYSTEM_SPACE_LIMIT=WORD(lynes.12,1)
maxidle=WORD(lynes.13,1)
maxtime=WORD(lynes.14,1)
maxbps=WORD(lynes.15,1)
IF ~DATATYPE(maxbps,'W') THEN maxbps=2400
CALL SETCLIP('BBS_baud',maxbps)
DO i=16 TO 40
j=i-15
bbsprefs.j=STRIP(WORD(lynes.i,1))
END
spellpath=WORD(lynes.9,1)
IF bbsprefs.5 & ~EXISTS(spellpath) THEN
DO
SAY spellpath 'does not exist!'
bbsprefs.5=0
END
IF bbsprefs.10 THEN scratch=bbspath'Scratch'
ELSE scratch='RAM:Scratch'
CALL MAKEDIR(scratch)
IF ~DATATYPE(bbsprefs.16,'W') THEN bbsprefs.16=3
extension=WORD(lynes.32,1)
arccom=lynes.33
compos=POS('/*',lynes.33)
IF compos>0 THEN lynes.33=LEFT(lynes.33,compos-1)
arccom=STRIP(lynes.33)
IF LEFT(extension,1)~='.' THEN
DO
extension='.lzh'
arccom='lharc -m m'
END
RETURN
readlogs:
IF arg='' THEN
arg=getinput(1 0 '['pen3'RETURN'def']=TODAY, or enter Log Date ('pen3||DATE('S')||def') > ')
IF arg='' THEN arg=DATE('S')
arg=bbspath'Logs/log.'arg
CALL readlines(arg 1)
CALL seelines(0)
nonstop=0
CALL waiting()
RETURN
loadcourtesy:
IF courtesyflag=0 & courtesy='' & EXISTS(bbspath'Lists/Courtesy') THEN
DO
IF readopen(bbspath'Lists/Courtesy') THEN
DO
SAY 'Checking Courtesy List...'
DO i=1
line=READLN(f)
IF EOF(f) THEN BREAK
courtesy=courtesy UPPER(line)
END
CALL CLOSE(f)
MSG ''
MSG pen3'Courtesy List:'def
MSG courtesy
END
END
RETURN
fileheader:
SAY 'Filename Bytes File# Library KeyWords'
SAY pen3||LEFT('=',77,'=')||def
RETURN
showalpha:
IF DATATYPE(arg,'W') THEN
DO
dirnum=arg
arg=''
IF chdir2()>0 THEN RETURN
test='Y'
END
ELSE
DO
test=getinput(1 1 'Show one library only? (Ny) > ')
IF test='Y' THEN
IF chdir()>0 THEN RETURN
END
showalpha2:
IF test='Y' THEN filecount=WORDS(SHOWDIR(bbspath'FileNotes/'plaindir))
ELSE filecount=files.0
SAY ' 'filecount 'files.'
CALL fileheader()
count=0
DO wi=1 TO alpha.0
CALL busywait(60 wi alpha.0)
IF test='Y' THEN
DO
IF count>=filecount THEN LEAVE wi
IF UPPER(LEFT(plaindir,12))~=UPPER(LEFT(WORD(alpha.wi,5),12)) THEN
ITERATE wi
END
jj=WORD(alpha.wi,4)
IF jj>level | FIND(data.21,UPPER(dirs.jj))>0 THEN
ITERATE wi
CALL busywait(4 0)
SAY LEFT(alpha.wi,76)
count=count+1
IF (count+2)//linesperpage=0 THEN
IF waiting2() THEN LEAVE wi
CALL busywait(4 1)
END
CALL busywait(4 0)
nonstop=0
IF waitchar~='Q' THEN CALL waiting()
RETURN
profiles:
prodir=bbspath'Profiles'
CALL MAKEDIR(prodir)
pros=SHOWDIR(prodir)
protxt=bbspath'BBS_TEXT/PROFILES'
IF EXISTS(protxt) THEN CALL showtext(protxt)
DO lupe=1
SAY
SAY ' 1. Edit 'name'''s user Profile'
SAY ' 2. View a User Profile'
SAY ' 3. Search User Profiles'
SAY ' 4. Browse User Profiles'
SAY
temp=getinput(1 1 'Enter Selection Number > ')
IF temp=1 THEN
DO
lynes.=''
IF EXISTS(prodir'/'name) THEN
DO
IF readlines(prodir'/'name 1)~=0 THEN ITERATE lupe
CALL DELETE(prodir'/'name)
END
ELSE lynes.0=3
lynes.1=name
lynes.2='Profile Last Updated:' DATE('W') DATE() TIME('C')
lynes.3=LEFT('=',74,'=')
IF savelines(prodir'/'name)~=0 THEN
DO
line='Profile for' name 'failed to save!'
SAY line
CALL send2log(line)
ITERATE lupe
END
edtype=''
CALL bbsEd(4 prodir'/'name)
IF readlines(prodir'/'name 1)~=0 THEN CALL DELETE(prodir'/'name)
IF lynes.0<4 THEN CALL DELETE(prodir'/'name)
pros=SHOWDIR(prodir)
END
ELSE IF temp=2 THEN
DO pf=1
totpros=WORDS(pros)
DO pfl=1 TO totpros BY 3
pfl2=pfl+1
pfl3=pfl+2
pfline=pen3||RIGHT(pfl,3)||def LEFT(WORD(pros,pfl),21)
IF pfl2<=totpros THEN
pfline=pfline pen3||RIGHT(pfl2,3)||def LEFT(WORD(pros,pfl2),21)
IF pfl3<=totpros THEN
pfline=pfline pen3||RIGHT(pfl3,3)||def LEFT(WORD(pros,pfl3),21)
SAY pfline
IF nonstop~=1 & ((pfl3%3)//linesperpage)=0 THEN
IF waiting(2) THEN LEAVE pfl
END
emnum=getinput(1 0 pen3'Select User Profile Number > 'def)
IF DATATYPE(emnum,'W') & emnum>0 & emnum<=totpros THEN
DO
tmp=WORD(pros,emnum)
IF level>sysoplevel THEN
DO
CALL bbsEd(1 prodir'/'tmp)
IF readlines(prodir'/'tmp 1)~=0 THEN CALL DELETE(prodir'/'tmp)
IF lynes.0<4 THEN CALL DELETE(prodir'/'tmp)
pros=SHOWDIR(prodir)
END
ELSE CALL showtext(prodir'/'tmp)
END
ELSE LEAVE pf
END
ELSE IF temp=3 | temp=4 THEN
DO
searcharg=''
nonstop=0
IF temp=3 THEN
DO
searcharg=STRIP(getinput(0 0 'Enter Search Phrase > '))
IF searcharg='' THEN ITERATE lupe
END
DO ui=1 TO WORDS(pros)
pro=prodir'/'WORD(pros,ui)
IF temp=3 THEN
IF textsearch(pro searcharg)=0 THEN ITERATE ui
SAY
CALL readlines(pro 1)
IF nonstop=1 THEN rnonstop=1
ELSE rnonstop=0
CALL seelines(2)
IF rnonstop THEN nonstop=1
ELSE IF waiting2()=1 THEN LEAVE ui
SAY
SAY
END
END
ELSE IF temp='' | LEFT(temp,1)='Q' THEN LEAVE lupe
END
DROP pros
RETURN
otheruser:
line=''
IF level>sysoplevel THEN line='['pen3'R'def']eport or'
line=line '['pen3'D'def']etails or simple ['pen3'N'def']amelist?'
IF level>sysoplevel THEN line=line '(Dnr) > '
ELSE line=line '(Dn) > '
temp=getinput(1 1 line)
IF temp='N' THEN
DO
CALL showuserlist()
RETURN
END
ELSE IF level>sysoplevel & temp='R' THEN
DO
SAY
line=''
IF getinput(1 1 'Report on inactive users? (nY) > ')~='N' THEN
DO
CALL cleanline(0)
SAY 'INACTIVE_USERS report will be in your email.'
line='USERS '
END
IF getinput(1 1 'Report on actual files vs. filelists? (nY) > ')~='N' THEN
DO
CALL cleanline(0)
line=line'FILES'
line=STRIP(line getinput(1 0 'Report only files larger than (0) bytes > '))
SAY 'FILELISTS_REPORT will be in your email.'
END
SAY
ADDRESS AREXX bbsREPORT.rexx name line
RETURN
END
SAY
SAY 'To allow (or not) other users to see your street address and/or phone number,'
SAY 'add (or delete) STREET and/or PHONE to the line 8 list in ['pen3'Y'def']our userfile.'
SAY
SAY 'User specification may include ? wildcard for single characters.'
SAY 'ie,' pen3's?n'def 'will return all user names containing ''son'', ''sen'', ''sin'', etc.'
IF arg='' THEN arg=getinput(1 0 pen3'User specification: 'def)
IF arg='' THEN RETURN
arg=TRANSLATE(STRIP(arg),'_',' ')
CALL FileList(bbspath'Users/*'arg'*',wildlist)
line='Found' wildlist.0 'match'
IF wildlist.0~=1 THEN line=line'es'
SAY line'.'
IF wildlist.0<1 THEN RETURN
totlines=0
nextpagebreak=linesperpage-3
extrainfo=0
IF level>sysoplevel THEN
DO
IF getinput(1 1 'Display -sysop only- information? (nY) > ')~='N' THEN
extrainfo=1
END
DO i=1 TO wildlist.0
CALL readlines(wildlist.i 1)
SAY
totlines=totlines+6
SAY bak2' 'SUBSTR(wildlist.i,LASTPOS('/',wildlist.i)+1)' 'def
SAY lynes.1
IF FIND(UPPER(lynes.8),'STREET')>0 THEN
DO
totlines=totlines+1
SAY lynes.2
END
SAY lynes.3
IF FIND(UPPER(lynes.8),'PHONE')>0 THEN
DO
totlines=totlines+1
SAY lynes.4
END
SAY 'Last time on' bbsname':' DATE(,WORD(lynes.13,1),'S') WORD(lynes.13,2)
SAY pen3'Interests:'def lynes.10
IF extrainfo THEN
DO
SAY pen3' up:'def lynes.14
SAY pen3' down:'def lynes.15
temptot=0
DO j=1 TO WORDS(lynes.23)
IF DATATYPE(WORD(lynes.23,j),'W') THEN temptot=temptot+WORD(lynes.23,j)
END
SAY pen3' writ:'def temptot 'public messages.'
SAY pen3'level:'def lynes.20
totlines=totlines+4
IF lynes.21~='' THEN
DO
totlines=totlines+1
SAY pen3'excluded dirs:'def lynes.21
END
END
IF nonstop~=1 & totlines>=nextpagebreak THEN
DO
IF waiting2() THEN LEAVE i
nextpagebreak=totlines+linesperpage-5
END
END
nonstop=0
DROP wildlist.
IF waitchar~='Q' THEN CALL waiting()
RETURN
changename:
ARG cname
IF level<=sysoplevel THEN RETURN
IF cname='' THEN cname=getinput(1 0 'Current Username (include underscore): ')
IF readlines(bbspath'Users/'cname 1)>0 THEN RETURN
IF WORD(lynes,20)>=level THEN RETURN
CALL SETCLIP('BBS_oldname',cname)
CALL ChangeUserName.rexx()
cname=GETCLIP('BBS_newname')
CALL DELETE(bbspath'Lists/USERS')
sortuserflag=1
CALL SETCLIP('BBS_oldname')
CALL SETCLIP('BBS_newname')
RETURN cname
levelreport:
minlev=0
maxlev=99
templist=''
uname=''
newufile=bbspath'Lists/NEW_USERS'
IF EXISTS(newufile) THEN
DO
IF getinput(1 1 'Latest New Users Only? (nY) > ')~='N' THEN
DO
IF readlines(newufile 1)=0 THEN
DO i=2 TO lynes.0
templist=STRIP(templist WORD(lynes.i,3))
END
END
ELSE newufile=''
END
ELSE newufile=''
IF newufile='' THEN
DO
minlev=getinput(1 0 'Minimum level? (0) > ')
maxlev=getinput(1 0 'Maximum level? (99) > ')
IF ~DATATYPE(minlev,'W') THEN minlev=0
IF ~DATATYPE(maxlev,'W') THEN maxlev=99
IF minlev<0 | minlev>99 THEN minlev=0
IF maxlev<0 | maxlev>99 THEN maxlev=99
templist=userlist
END
DO levi=1 TO WORDS(templist)
arg=bbspath'Users/'WORD(templist,levi)
CALL readlines(arg 1)
lt=WORD(lynes.20,1)
IF ~DATATYPE(lt,'W') THEN lt=0
IF lt<minlev | lt>maxlev THEN ITERATE levi
line=lt WORD(templist,levi)
SAY line
IF newufile~='' | lt<10 THEN
DO
SAY line
DO levj=1 TO 12
SAY pen3' 'lynes.levj||def
END
SAY pen3' 'lynes.19||def
END
ELSE ITERATE levi
lcom=''
IF lt<10 THEN lcom='['pen3'A'def']dd or '
lcom=lcom'['pen3'K'def']ill or ['pen3'R'def']ename or ['pen3'S'def']kip this user?'
IF lt<10 THEN lcom=lcom' (Akrs) > '
ELSE lcom=lcom '(krS) > '
lcom=getinput(1 1 lcom)
CALL cleanline(0)
IF lcom='K' THEN
DO
arg=WORD(templist,levi)
CALL killuser()
END
ELSE IF lcom='R' THEN
DO
newname=changename(WORD(templist,levi))
IF newname~='' & newname~=WORD(templist,levi) THEN
DO
temp=WORDINDEX(templist,levi+1)
rtemp=''
IF temp>0 THEN rtemp=SUBSTR(templist,temp)
temp=WORDINDEX(templist,levi)
templist=''
IF temp>2 THEN templist=STRIP(LEFT(templist,temp-1))
templist=STRIP(templist newname rtemp)
userlist=userlist newname
END
levi=levi-1
CALL SETCLIP('BBS_newname')
END
ELSE IF lcom~='S' & lt<10 THEN
DO
IF readopen(bbspath'BBS_TEXT/DEF.MEMBER') THEN
DO
DO lvi=1 TO 22
line=READLN(f)
IF lvi=11 THEN lynes.11=line
IF lvi=20 THEN lynes.20=line
IF lvi=21 THEN lynes.21=line
END
lynes.22=line
CALL CLOSE(f)
edtype=''
IF bbsprefs.25=1 THEN
DO
SAY
IF DATATYPE(lynes.20,'W') THEN
DO
lynes.22=''
lynes.23=''
SAY 'Setting message counters to last 10 messages in each conference...'
DO i=1 TO lynes.20
num=countcheck(bbspath'Numbers/LastMessage'i 0)-10
IF num<0 | msg.i.0<10 THEN num=0
lynes.22=lynes.22 num
lynes.23=lynes.23 0
END
END
ELSE SAY 'Bad default level in BBS_TEXT/DEF.MEMBER file!'
SAY 'Setting file counter to last file uploaded...'
lynes.16=countcheck(bbspath'Numbers/LastFile' 0)
lynes.16=lynes.16 '19900101 00:00:00'
END
lynes.0=27
CALL savelines(arg)
SAY lynes.20 WORD(templist,levi) 'has been made a member.'
END
ELSE SAY 'You need a default member file in BBS_TEXT! ( BBS_TEXT/DEF.MEMBER )'
END
IF lcom~='K' & lcom~='R' & newufile~='' THEN
DO
nlt=getinput(1 0 lynes.20 'Enter new level or blank for no change. > ')
IF DATATYPE(nlt,'W') THEN
DO
lynes.20=nlt
CALL savelines(arg)
END
CALL writenew()
END
END
IF newufile~='' & EXISTS(newufile) THEN
IF getinput(1 1 'Delete NEW_USERS file? (nY) > ')~='N' THEN CALL DELETE(newufile)
IF EXISTS(bbspath'Lists/CBV_USERS') THEN
IF getinput(1 1 'Delete CBV_USERS file? (nY) > ')~='N' THEN
CALL DELETE(bbspath'Lists/CBV_USERS')
DROP templist
RETURN
writenew:
arg=WORD(templist,levi)
IF getinput(1 1 'Write' arg 'an email message? (nY) > ')~='N' THEN
DO
IF EXISTS(bbspath'BBS_TEXT/EMAIL_WELCOME') THEN
IF getinput(1 1 'Use default welcome? (nY) > ')~='N' THEN replysubj='|@NEW@|'
CALL editor('MAIL' arg)
END
RETURN
filereport:
SAY 'Searching for mismatches between files and filenotes...'
DO i=1 TO sysoplevel+1
IF dirs.i='' THEN ITERATE
SAY dirs.i' 'lineup
rfiles=SHOWDIR(libpath||dirs.i)
rnotes=SHOWDIR(bbspath'FileNotes/'dirs.i)
IF WORDS(rfiles)~=WORDS(rnotes) THEN
DO
line='Compare files & filenotes in'pen3 dirs.i||def'. '
DO j=1 TO WORDS(rfiles)
IF FIND(UPPER(rnotes),UPPER(WORD(rfiles,j)))=0 THEN
line=line WORD(rfiles,j)
END
SAY line
END
END
SAY '07'x
CALL waiting()
RETURN
mailreport:
SAY 'Checking ALL pending Email...'
SAY pen3' - Use CTRL-E to Exit -'def
SAY
mailrep=SHOWDIR(bbspath'Email','D')
mailfil=SHOWDIR(bbspath'EmailFiles','D')
lastemail=WORD(data.17,3)
IF ~DATATYPE(lastemail,'W') THEN lastemail=0
IF lastemail=countcheck(bbspath'Numbers/LastMail' 0) THEN
DO
DROP mailrep. mailfil.
RETURN
END
mailynes.=''
mk=0
DO mi=1 TO WORDS(mailrep)
muser=WORD(mailrep,mi)
IF muser=sysop | muser=name THEN ITERATE mi
mlist=SHOWDIR(bbspath'Email/'muser)
IF WORDS(mlist)>0 THEN SAY lineup||RIGHT(muser,40)
DO mj=1 TO WORDS(mlist)
fuser=WORD(mlist,mj)
IF POS(sysop,fuser)>0 THEN ITERATE mj
IF logonflag=0 THEN
DO
mk=mk+1
mailynes.mk=pen3||LEFT(muser,20) 'from'def LEFT(fuser,20) DATE(,WORD(STATEF(bbspath'Email/'muser'/'fuser),5),'I')
END
IF POS(sysop,fuser)=0 & POS(name,fuser)=0 THEN
DO
testnum=RIGHT(fuser,LENGTH(fuser)-LASTPOS('.',fuser))
IF testnum>emailnum THEN emailnum=testnum
IF testnum>lastemail THEN
DO
CALL showtext(bbspath'Email/'muser'/'fuser)
SAY
SAY
IF waitchar='Q' THEN LEAVE mi
END
END
END
IF logonflag=0 & FIND(mailfil,muser)>0 THEN
DO
efilelist=SHOWDIR(bbspath'EmailFiles/'muser)
IF WORDS(efilelist)>0 THEN
DO
mk=mk+1
mailynes.mk=pen3||LEFT(muser,20) 'emailfiles'def efilelist
END
END
END
data.17=WORD(data.17,1) WORD(data.17,2) countcheck(bbspath'Numbers/LastMail' 0)
IF mk>0 THEN
DO
lynes.0=mk
DO mi=1 TO mk
lynes.mi=mailynes.mi
END
CALL seelines(1)
nonstop=0
CALL waiting()
END
ELSE SAY 'No unseen Email pending.'
DROP mailrep. mailfil. mailynes. mlist
RETURN
sortdoors:
IF ~DATATYPE(jdoors.0,'W') THEN doors.0=0
IF WORDS(SHOWDIR(bbspath'rexxDoors','F'))~=doors.0 THEN
DO
jdoors.=''
doorlist=SHOWDIR(bbspath'rexxDoors','F')
doors.=''
doors.0=WORDS(doorlist)
DO i=1 TO doors.0
doors.i=WORD(doorlist,i)
END
SAY 'Sorting..'lineup
CALL QSORT(1,doors.0,doors)
jdoors.0=doors.0%3
IF (doors.0//3)>0 THEN jdoors.0=jdoors.0+1
DO i=1 TO jdoors.0
DO j=0 TO 2
k=i+j*jdoors.0
IF k<=doors.0 THEN
DO
jdoors.i=jdoors.i' 'LEFT(RIGHT(k,3)'.' LEFT(doors.k,LENGTH(doors.k)-5),24)
dcount=WORD(STATEF(bbspath'rexxDoors/'doors.k),8)
jdoors.i.0=jdoors.i.0||LEFT(RIGHT(dcount,5) LEFT(doors.k,LENGTH(doors.k)-5),24)' '
END
END
END
END
RETURN 0
jump2rexx:
CALL sortdoors()
temp=1
readcount=-1
DO doorloop=1
IF temp=0 THEN
DO
IF readcount~=-1 THEN
DO
doors.0=''
CALL sortdoors()
END
SAY CENTER('- Number of accesses per file -',75)
END
SAY pen3||LEFT('-',75,'-')||def
DO jd=1 TO jdoors.0
IF temp=0 THEN SAY jdoors.jd.0
ELSE SAY jdoors.jd
IF jd//linesperpage=0 THEN CALL waiting()
IF waitchar='Q' THEN LEAVE doorloop
END
IF temp=0 THEN
DO
CALL waiting()
temp=1
ITERATE doorloop
END
temp=getinput(1 0 pen3'Select Application Number. 0=Stats > 'def)
IF temp=0 THEN ITERATE doorloop
IF ~DATATYPE(temp,'W') | temp<1 | temp>doors.0 THEN LEAVE doorloop
arg=doors.temp
IF GETCLIP('BBS_door')=arg THEN
DO
SAY 'That door is in use!'
ITERATE doorloop
END
CALL SETCLIP('BBS_localdoor',arg)
readcount=WORD(STATEF(bbspath'rexxDoors/'arg),8)
IF ~DATATYPE(readcount,'W') THEN readcount=0
ADDRESS COMMAND 'C:filenote' bbspath'rexxDoors/'arg readcount+1
curdir=PRAGMA('D')
CALL setdir(bbspath'rexxDoors')
bbspath'rexxDoors/'doors.temp name winnings 0 colorflag 6000
CALL setdir(curdir)
CALL SETCLIP('BBS_localdoor')
END
CALL SETCLIP('BBS_localdoor')
RETURN
sortlibraries:
SAY 'Sorting Libraries...'
count=0
sdirs.=''
DO i=1 TO level
IF dirs.i='' THEN ITERATE i
count=count+1
sdirs.count=dirs.i i
END
sdirs.0=count
CALL QSort(1,count,sdirs)
count=0
libs.=''
DO i=1 TO sdirs.0
tempnum=WORD(sdirs.i,2)
tempdir=WORD(sdirs.i,1)
IF FIND(data.21,UPPER(tempdir))=0 THEN
DO
string=' '
IF tempnum<10 THEN string=string' '
string=string || tempnum'. 'LEFT(tempdir,14)
count=count+1
libs.count=string
END
END
libs.0=count%4
IF (count//4)>0 THEN libs.0=libs.0+1
DO i=1 TO libs.0
DO j=1 TO 3
k=i+j*libs.0
IF k<=count THEN libs.i=libs.i||libs.k
END
END
DROP sdirs.
CALL sortconferences()
RETURN
sortconferences:
SAY 'Sorting Conferences...'
count=0
smsg.=''
DO i=1 TO level
IF msg.i='' THEN ITERATE i
count=count+1
smsg.count=msg.i i
END
smsg.0=count
CALL QSort(1,count,smsg)
count=0
msgs.=''
DO i=1 TO smsg.0
tempnum=WORD(smsg.i,2)
tempdir=WORD(smsg.i,1)
IF FIND(data.21,tempnum)=0 THEN
DO
string=' '
IF tempnum<10 THEN string=string' '
string=string || tempnum'.'
IF WORD(data.22,tempnum)='' | WORD(data.22,tempnum)>=0 THEN
string=string LEFT(tempdir,20)
ELSE string=string pen3'-OFF-'def LEFT(tempdir,14)
count=count+1
msgs.count=string
END
END
msgs.0=count%3
IF (count//3)>0 THEN msgs.0=msgs.0+1
DO i=1 TO msgs.0
DO j=1 TO 2
k=i+j*msgs.0
IF k<=count THEN msgs.i=msgs.i msgs.k
END
END
DROP smsg.
RETURN
readmessages:
searcharg=''
DO FOREVER
SAY
PARSE VAR arg temp' 'arg .
IF DATATYPE(temp,'W') THEN msgdir=temp
ELSE IF LEFT(UPPER(temp),1)='A' THEN
DO
CALL newmsgs()
arg=''
RETURN
END
ELSE IF LEFT(UPPER(temp),1)='M' THEN
DO
CALL readmarked()
arg=''
RETURN
END
ELSE
DO
SAY 'Select Message Conference By Number, ['pen3'M'def']arked only or ['pen3'A'def']ll Active'
IF areaselect() THEN
DO
IF LEFT(temp,1)='A' THEN CALL newmsgs()
IF LEFT(temp,1)='M' THEN CALL readmarked()
RETURN
END
END
pline='['pen3'A'def']rchive ['pen3'S'def']earch ['pen3'T'def']oggle ON/OFF'
pline=pline '['pen3'R'def']ead ['pen3'Q'def']uit (aqRst) > '
IF arg~='' THEN junk=UPPER(LEFT(arg,1))
ELSE junk=getinput(1 1 pline)
IF junk='Q' THEN RETURN
IF junk='A' THEN
DO
SAY
CALL msgcount(msgdir)
junk=getinput(1 0 pen3'RETURN'def' to archive new msgs, ['pen3'Q'def']uit, or enter starting message number > ')
IF junk='Q' THEN RETURN
IF DATATYPE(junk,'W') THEN
DO
IF junk>lastmess | junk<1 THEN junk=1
lastread.msgdir=junk-1
CALL savedata(1)
END
CALL SETCLIP('BBS_MSGS','ON')
SAY 'Archiving messages in the'pen3 msg.msgdir def'Conference...'
lastread.msgdir=lastmess
ADDRESS AREXX ArcMsgs.rexx name msgdir
IF emailonline>=0 THEN emailonline=emailonline+1
DO WHILE GETCLIP('BBS_MSGS')~=''
CALL DELAY(14)
END
SAY 'When completed, the archive will be attached to email addressed to you.'
CALL savedata(1)
SAY
RETURN
END
IF junk='S' THEN
DO
searcharg=''
searcharg=getinput(0 0 pen3'Search Phrase: 'def)
IF LENGTH(STRIP(searcharg))=0 THEN RETURN
searcharg=COMPRESS(searcharg,'*')
SAY
CALL searchmsgdir()
SAY
SAY 'All messages in the'pen3 msg.msgdir def'Conference have been searched.'
SAY
CALL waiting()
searcharg=''
RETURN
END
IF junk='T' THEN
DO
line='Turning the' msg.msgdir 'conference'
IF WORD(data.22,msgdir)<0 THEN
DO
line=line pen3'ON'def'.'
newdata='0'
END
ELSE
DO
line=line pen3'OFF'def'.'
newdata='-1'
END
SAY line
dataloc=WORDINDEX(data.22,msgdir)-1
data.22=DELWORD(data.22,msgdir,1)
IF dataloc>0 THEN data.22=INSERT(newdata' ',data.22,dataloc)
CALL sortconferences()
END
CALL readmsg(0)
CALL saveData(1)
nonstop=0
arg=''
END
RETURN
newmsgs:
test=UPPER(LEFT(arg,1))
IF test='' THEN
test=getinput(1 1 '['pen3'R'def']ead new messages or ['pen3'A'def']rchive for later download. (aR) > ')
IF test='A' THEN
DO
CALL SETCLIP('BBS_MSGS','ON')
SAY
SAY 'Archiving new conference messages...'
ADDRESS AREXX ArcMsgs.rexx name
IF emailonline>=0 THEN emailonline=emailonline+1
clear_marked=1
DO i=1 TO level
IF WORD(data.22,i)~=-1 THEN
lastread.i=countcheck(bbspath'Numbers/LastMessage'i 0)
END
DO WHILE GETCLIP('BBS_MSGS')~=''
CALL DELAY(14)
END
SAY 'When completed, the archive will be attached to email addressed to you.'
CALL savedata(1)
SAY
RETURN
END
curmsgdir=msgdir
SAY 'Scanning all Conferences for new messages..'
DO newi=1 TO level
IF msg.newi='' THEN ITERATE newi
msgdir=newi
CALL readmsg(1)
IF msgcom='Q' THEN LEAVE newi
END
CALL saveData(1)
msgdir=curmsgdir
nonstop=0
RETURN
readmsg:
ARG quietflag marknum .
msgcom=''
IF msg.msgdir='' | FIND(data.21,msgdir)>0 THEN RETURN; /* sysop excluded */
IF WORD(data.22,msgdir)=-1 THEN RETURN; /* user excluded */
entering='Entering'pen3 msg.msgdir def'Message Conference..'
IF quietflag=0 & marknum='' THEN SAY entering
IF DATATYPE(WORD(data.22,msgdir),'W') THEN
lastread.msgdir=WORD(data.22,msgdir)
ELSE lastread.msgdir=0
lstwrt=countcheck(bbspath'Numbers/LastMessage'msgdir 0)
frstwrt=countcheck(bbspath'Numbers/FirstMessage'msgdir 0)
temp=''
IF marknum='' THEN
DO
IF lastread.msgdir>=lstwrt | lastread.msgdir<frstwrt THEN
DO
lastread.msgdir=lstwrt
CALL msgcount(msgdir)
IF quietflag=1 & lastread.msgdir=lstwrt THEN RETURN
IF nonstop=1 THEN temp=''
ELSE temp=getinput(1 0 pen3'Enter starting message number > 'def)
IF temp='' THEN temp=lastread.msgdir
IF ~DATATYPE(temp,'W') THEN RETURN
IF temp<frstwrt THEN temp=frstwrt
IF temp>lstwrt THEN temp=lstwrt
IF temp<1 THEN temp=1
lastread.msgdir=temp-1
END
END
ELSE lastread.msgdir=marknum-1
IF quietflag=1 THEN SAY entering
dirname=msgpath||msgdir
msglist.=0 /* set read to 0, unread to 1, and reply >=2 */
firstmess=999999
testlist=SHOWDIR(dirname)
DO i=1 TO WORDS(testlist)
test=WORD(testlist,i)
IF test>lastread.msgdir THEN msglist.test=1
IF test<firstmess THEN firstmess=test
END
IF firstmess=999999 THEN firstmess=0
CALL countcheck(bbspath'Numbers/FirstMessage'msgdir firstmess)
msgstatus=1
IF temp='' & marknum='' THEN CALL msgcount(msgdir)
skipsubj.=''
skipsubj.0=0
DO msgloop=1
lastreadnum=lastread.msgdir
DO WHILE msglist.lastreadnum=0 & lastreadnum<lstwrt
lastreadnum=lastreadnum+1
END
lastread.msgdir=lastreadnum
IF lastreadnum=lstwrt & msglist.lstwrt=0 THEN LEAVE msgloop
DO mess=lastread.msgdir TO lstwrt+1
IF marknum~='' THEN
DO
IF mess>marknum THEN LEAVE msgloop
mess=marknum
END
IF msglist.mess~=msgstatus THEN ITERATE mess
IF msgstatus>1 THEN SAY 'Following the thread, level' msgstatus-1'.'
msglist.mess=0
arg=dirname'/'mess
IF ~EXISTS(arg) THEN
DO
SAY 'Message number' mess 'is missing.'
ITERATE mess
END
IF ~readopen(arg) THEN ITERATE mess
firstline=READLN(f)
secondline=READLN(f)
thirdline=READLN(f)
forthline=READLN(f)
CALL CLOSE(f)
CALL killmark(msgdir mess)
DO skp=1 TO skipsubj.0
IF forthline=skipsubj.skp THEN ITERATE mess
END
IF WORDS(firstline)>2 THEN /* if replies, change their num to >1 */
DO
thread=SUBSTR(firstline,WORDINDEX(firstline,4))
DO tindx=1 TO WORDS(thread)
test=WORD(thread,tindx)
IF msglist.test~=0 THEN msglist.test=msgstatus+1
END
END
savearg=arg
msgcom='A'
DO msgloop2=1 WHILE msgcom='A' | msgcom='O'
CALL readlines(arg 1)
IF nonstop=1 THEN rnonstop=1
ELSE rnonstop=0
CALL seelines(2)
msgcom=''
IF rnonstop THEN
DO
SAY
nonstop=1
msgcom=''
END
ELSE
DO
pline=''
IF level<=sysoplevel | WORDS(lynes.3)<3 THEN pline='['pen3'A'def']gain'
IF level>sysoplevel | name=WORD(lynes.2,2) THEN
pline=pline '['pen3'E'def']dit ['pen3'K'def']ill'
IF level>sysoplevel THEN pline=pline '['pen3'M'def']ove'
IF WORDS(lynes.3)>3 THEN pline=pline '['pen3'O'def']riginal'
pline=pline '['pen3'N'def']onStop ['pen3'R'def']eply'
IF level=99 THEN pline=pline '['pen3'!'def']'
pline=pline '['pen3'S'def']kip ['pen3'Q'def']uit ['pen3'?'def']'
msgcom=getinput(1 0 STRIP(pline)' > ')
CALL cleanline(0)
END
IF DATATYPE(msgcom,'W') & EXISTS(dirname'/'msgcom) THEN
DO
arg=dirname'/'msgcom
IF msgcom>lastread.msgdir THEN lastread.msgdir=msgcom
msgcom='A'
ITERATE msgloop2
END
ELSE msgcom=LEFT(msgcom,1)
IF msgcom='Q' THEN LEAVE msgloop
ELSE IF msgcom='!' & level>sysoplevel THEN
DO
CALL DELETE(arg)
newchar=LEFT(lynes.1,1)
IF newchar~='!' THEN newchar='!!'
ELSE newchar=' '
lynes.1=OVERLAY(newchar,lynes.1,1,2)
CALL savelines(arg)
ITERATE msgloop2
END
ELSE IF msgcom='A' THEN ITERATE msgloop2
ELSE IF msgcom='M' & level>sysoplevel THEN
DO
prevmsgdir=msgdir
If ~areaselect() THEN
DO
himsg=countcheck(bbspath'Numbers/LastMessage'msgdir 0)+1
lynes.1=' Msg:' himsg
lynes.3=' To:' WORD(lynes.3,2)
lynes.5=STRIP(DELWORD(lynes.5,8,1)) msg.msgdir
nlyn=lynes.0+1
lynes.0=nlyn
lynes.nlyn=' *** Moved from the' msg.prevmsgdir 'conference ***'
CALL savelines(msgpath||msgdir'/'himsg)
CALL countcheck(bbspath'Numbers/LastMessage'msgdir himsg)
CALL msgmark(WORD(lynes.3,2) msgdir himsg)
CALL readlines(arg 1)
CALL DELETE(arg)
CALL DELAY(28)
lynes.0=7
lynes.7='*** Moved to the' msg.msgdir 'conference, message #'himsg' ***'
CALL savelines(arg)
END
msgdir=prevmsgdir
msgcom='A'
END
ELSE IF msgcom='N' THEN
DO
nonstop=1
msgcom=''
END
ELSE IF msgcom='H' | msgcom='?' THEN
DO
SAY pen3' - HELP with the Read Messages commands -'def
SAY ' RETURN reads the next message in line.'
SAY ' 34 will read message number 34, if it exists in this conference.'
SAY ' A reads this message Again (in case it scrolled off screen).'
IF level>sysoplevel | name=WORD(lynes.2,2) THEN
DO
SAY ' E puts this message into the online Editor.'
SAY ' K deletes a message you wrote. you cannot Kill others!'
END
IF level>sysoplevel THEN
SAY ' M move this message to a new conference.'
SAY ' N displays all new messages without pausing. CTRL-E to Exit!'
SAY ' O if this message is a reply, will read the Original message.'
SAY ' R enters the message editor to Reply to this message.'
SAY ' S allows you to Skip threads or conferences.'
IF level=99 THEN
SAY ' ! toggles the do-not-purge! flag for this message.'
SAY ' Q returns to the message menu. (Quit)'
SAY
CALL waiting()
msgcom='A'
IF waitchar='Q' THEN LEAVE msgloop
END
ELSE IF msgcom='E' THEN
DO
IF level>sysoplevel | name=WORD(lynes.2,2) THEN
DO
sline=7
IF level>sysoplevel THEN sline=1
CALL bbsED(sline arg)
msgcom='A'
END
END
ELSE IF msgcom='S' & mess<lstwrt THEN
DO
stemp=''
DO WHILE stemp~='T' & stemp~='C'
stemp=getinput(1 1 'Skip this ['pen3'T'def']hread or the entire ['pen3'C'def']onference (ct) > ')
END
IF stemp='T' THEN
DO
SAY
SAY pen3 forthline||def
SAY 'Skipping messages with this subject heading...'
SAY
DO i=lastread.msgdir TO lstwrt
IF msglist.i>1 THEN msglist.i=0
END
skipsubj.0=skipsubj.0+1
sksb=skipsubj.0
skipsubj.sksb=forthline
END
ELSE
DO
SAY pen3'Skipping to the last message in the'def msg.msgdir pen3'conference.'def
lastread.msgdir=lstwrt-1
lw=lstwrt-1
msglist.lw=0
msglist.lstwrt=1
LEAVE mess
END
END
ELSE IF msgcom='K' THEN
DO
IF level>sysoplevel | name=WORD(lynes.2,2) THEN
DO
IF getinput(1 1 'Really delete' arg'? (Ny) > ')='Y' THEN
DO
IF DELETE(arg)=1 THEN
SAY pen3||arg||def' has been deleted.'
grand=grand-1
msg.msgdir.0=msg.msgdir.0-1
END
END
END
ELSE IF msgcom='O' THEN /* go back and read original */
DO
IF WORDS(lynes.3)>3 THEN
DO
temp=WORD(lynes.3,4)
arg=dirname'/'temp
END
ELSE SAY 'This is the original message.'
END
ELSE IF msgcom='R' THEN /* toname msgnum */
DO
msgnum=WORD(lynes.1,2)
forthline=lynes.4
IF editor('REPLY' WORD(lynes.2,2) msgnum) THEN /* reply */
DO
savearg2=arg
arg=dirname'/'WORD(lynes.3,4)
IF EXISTS(arg) THEN
DO
IF readlines(arg 1) THEN BREAK
xmsg=countcheck(bbspath'Numbers/LastMessage'msgdir mess)
IF WORDS(lynes.1)>3 THEN lynes.1=lynes.1 xmsg
ELSE lynes.1=lynes.1' Reply' xmsg
CALL DELAY(28) /* allow 1/2 sec for read to close */
CALL savelines(arg)
END
arg=savearg2
END
END
ELSE IF arg~=savearg THEN /* Continue */
DO
msgcom='A'
arg=savearg
END
END
IF thread~='' THEN
DO
thread=''
msgstatus=msgstatus+1
END
END
IF msgstatus>1 THEN msgstatus=msgstatus-1
END
DROP msglist. skipsubj.
IF quietflag~=1 THEN nonstop=0
RETURN
showmarked:
ARG ff .
IF WORDS(data.24)<1 THEN RETURN
fline='These unread conference messages have been ['pen3'M'pen6']arked as addressed to you:'
IF ff THEN
DO
SAY
SAY pen6||fline||def
END
tempkk=data.24
DO i=1 TO WORDS(tempkk)
tempk=WORD(tempkk,i)
PARSE VAR tempk kdir'/'kmsg
line=RIGHT(kmsg,6) 'in the'pen3 msg.kdir def'conference'
IF EXISTS(msgpath||tempk) THEN
DO
IF ff THEN SAY line'.'
ELSE fline=fline'0A'x||line'.'
END
ELSE
DO
line=line 'is missing.'
IF ff THEN SAY line
ELSE fline=fline'0A'x||line
data.24=DELWORD(data.24,FIND(data.24,tempk),1)
END
END
IF ff THEN
DO
CALL waiting()
SAY
END
ELSE
DO
IF writeopen(bbspath'EmailFiles/'name'/Marked')=0 THEN RETURN
CALL WRITELN(f,fline)
CALL CLOSE(f)
END
RETURN
killmark:
PARSE ARG kdir kmsg .
IF data.24='' THEN RETURN
markword=FIND(data.24,kdir'/'kmsg)
IF markword>0 THEN data.24=STRIP(DELWORD(data.24,markword,1))
RETURN
readmarked:
mrknum=WORDS(data.24)
IF mrknum=0 THEN RETURN
SAY 'Reading only messages addressed to you...'
mrklist=data.24
msgcom=''
DO rmki=1 TO mrknum WHILE msgcom~='Q'
tempk=WORD(mrklist,rmki)
PARSE VAR tempk mkdir'/'mkmsg .
IF ~EXISTS(msgpath||tempk) THEN
DO
CALL killmark(mkdir mkmsg)
SAY
SAY 'Message number' mkmsg 'in the' msg.mkdir 'conference is missing!'
SAY
ITERATE rmki
END
msgdir=mkdir
savelast=lastread.msgdir
CALL readmsg(1 mkmsg)
IF mkmsg>savelast THEN lastread.msgdir=mkmsg
ELSE lastread.msgdir=savelast
END
CALL saveData(1)
RETURN
sortnumbers:
PARSE ARG slist
IF STRIP(slist)='' THEN RETURN ''
sorted.=''
oldest=999999
newest=0
newlist=''
DO si=1 TO WORDS(slist)
testword=WORD(slist,si)
IF ~DATATYPE(testword,'W') THEN
DO
testpos=LASTPOS('.',testword)
IF testpos>0 THEN tempnum=SUBSTR(testword,testpos+1)
ELSE
DO
newlist=testword newlist
ITERATE si
END
END
ELSE tempnum=testword/1
IF sorted.tempnum='' THEN
DO
sorted.tempnum=testword
sorted.tempnum.0=1
IF DATATYPE(tempnum,'W') THEN
DO
IF tempnum>newest THEN newest=tempnum
IF tempnum<oldest THEN oldest=tempnum
END
END
ELSE newlist=newlist testword
END
IF oldest~=999999 & newest~=0 THEN
DO si=oldest TO newest
IF sorted.si.0=1 THEN newlist=newlist sorted.si
END
DROP sorted. oldest newest
RETURN STRIP(newlist)
readmail:
ARG fromenu .
replysubj=''
IF fromenu THEN
DO
temp=UPPER(arg)
arg=''
IF temp~='F' & temp~='T' & temp~='W' THEN
DO
line='Find Email ['pen3'F'def']rom You ['pen3'T'def']o You or ['pen3'W'def']rite New Email (ftw) > 'def
temp=getinput(1 1 line)
CALL cleanline(0)
END
IF temp='W' THEN
DO
CALL editor('MAIL')
RETURN
END
ELSE IF temp='F' THEN
DO
firsteditline=0
picklist.=''
picklist.0=0
IF getinput(1 1 'Check ALL users? (nY) > ')='N' THEN
DO
picklist.1=getinput(1 0 'Check EMail From' name 'To Who? > ')
picklist.1=SPACE(STRIP(UPPER(picklist.1)),1,'_')
picklist.1=COMPRESS(picklist.1,'.,:/*#?^ ')
IF picklist.1='' THEN RETURN
IF FIND(userlist,picklist.1)=0 THEN
DO
SAY '***'pen3 picklist.1 def'does not exist!'
picklist.0=0
RETURN
END
fmaillist=SHOWDIR(bbspath'EMail/'picklist.1)
DO ej=1 TO WORDS(fmaillist)
ejname=WORD(fmaillist,ej)
uname=ejname
caret=LASTPOS('.',uname)
IF caret>2 THEN uname=LEFT(uname,caret-1)
IF uname=name THEN
DO
arg=bbspath'EMail/'picklist.1'/'ejname
IF EXISTS(arg) THEN
DO
pklst=picklist.0+1
picklist.pklst=picklist.1
picklist.pklst.0=ejname
picklist.0=pklst
END
END
END
IF picklist.0=0 THEN SAY 'No Email FROM you was found.'
ELSE
DO
SAY pen3'You have the following Email pending:'def
pickcheck=1
DO WHILE pickcheck~=0
pickcheck=pickfromlist()
IF pickcheck~=0 THEN
DO
firsteditline=5
IF level>sysoplevel THEN firsteditline=1
CALL bbsED(firsteditline bbspath'Email/'picklist.pickcheck'/'picklist.pickcheck.0)
IF ~EXISTS(bbspath'Email/'picklist.pickcheck'/'picklist.pickcheck.0) THEN
picklist.pickcheck='- KILLED -'
END
END
END
END
ELSE
DO
users=WORDS(userlist)
SAY pen3'Scanning'def users pen3'email directories...'def||CR
SAY pen3' - To ABORT, press CTRL-E -'def||CR
DO wi=1 TO users
CALL busywait(60 wi users)
fmaillist=SHOWDIR(bbspath'EMail/'WORD(userlist,wi))
DO ej=1 TO WORDS(fmaillist)
ejname=WORD(fmaillist,ej)
uname=ejname
caret=LASTPOS('.',uname)
IF caret>2 THEN uname=LEFT(uname,caret-1)
IF uname=name THEN
DO
arg=bbspath'EMail/'WORD(userlist,wi)'/'ejname
IF EXISTS(arg) THEN
DO
pklst=picklist.0+1
picklist.pklst=WORD(userlist,wi)
picklist.pklst.0=ejname
picklist.0=pklst
END
END
END
IF wi=999999 THEN RETURN
END
CALL busywait(4 0)
IF picklist.0=0 THEN SAY lineup'No Email FROM you was found. '
ELSE
DO
SAY pen3'You have Email pending to the following users:'def
pickcheck=1
DO WHILE pickcheck~=0
pickcheck=pickfromlist()
IF pickcheck~=0 THEN
DO
firsteditline=5
IF level>sysoplevel THEN firsteditline=1
CALL bbsED(firsteditline bbspath'Email/'picklist.pickcheck'/'picklist.pickcheck.0)
IF ~EXISTS(bbspath'Email/'picklist.pickcheck'/'picklist.pickcheck.0) THEN
picklist.pickcheck='- KILLED -'
END
END
END
END
DROP picklist.
RETURN
END
ELSE IF temp='T' THEN BREAK
ELSE RETURN
END
SAY 'Checking your mailbox..'
nomail=1
CALL MAKEDIR(bbspath'EMail/'name)
mailist=sortnumbers(SHOWDIR(bbspath'Email/'name))
IF WORDS(mailist)=0 THEN
DO
SAY lineup'Your mailbox is empty. '
SAY
RETURN
END
line=WORDS(mailist)
IF line>1 THEN line=line 'letters'
ELSE line=line 'letter'
line=line 'waiting.'
SAY line
DO ii=1 TO WORDS(mailist)
SAY 'Email:' pen3||WORD(mailist,ii)||def
END
IF ~fromenu THEN
IF getinput(1 1 'Read your private mail now? (nY) > ')='N' THEN RETURN
onename=''
IF WORDS(mailist)>3 THEN
DO
IF getinput(1 1 'Read all private mail? (nY) > ')='N' THEN
DO
onename=getinput(1 0 'Read ONLY private mail from? > ')
onename=SPACE(STRIP(UPPER(onename)),1,'_')
onename=COMPRESS(onename,'.,:/*#?^ ')
IF onename='' THEN RETURN
IF FIND(userlist,onename)=0 & picklist.1~='BBBBS' THEN
DO
SAY '***'pen3 onename def'does not exist!'
RETURN
END
END
END
DO letter=1 TO WORDS(mailist)
readname=WORD(mailist,letter)
uname=readname
caret=LASTPOS('.',uname)
IF caret>2 THEN uname=LEFT(uname,caret-1)
IF onename~='' & onename~=uname THEN ITERATE letter
arg=bbspath'Email/'name'/'readname /* user has mail! */
CALL readlines(arg 1)
delnum=WORD(lynes.1,2)
CALL seelines(1)
nomail=0
nonstop=0
mailfile=''
IF UPPER(WORD(lynes.1,3))='FILE:' THEN mailfile=WORD(lynes.1,4)
ELSE IF UPPER(WORD(lynes.2,3))='FILE:' THEN mailfile=WORD(lynes.2,4)
IF mailfile~='' & readname~='NEW_FILES' & readname~='FILELISTS_REPORT' & readname~='INACTIVE_USERS' & LEFT(readname,3)~='MSG' THEN
DO
IF LEFT(RIGHT(mailfile,4),1)~='.' & LEFT(readname,6)='BBBBS.' THEN
DO
SAY
SAY pen3'The attached file is unarchived and may be incomplete.'
SAY 'If the archiver is still building this file, downloading will fail.'def
IF getinput(1 1 'Do you want to try to download it anyway? (Ny) > ')~='Y' THEN ITERATE letter
SAY
END
curdir=PRAGMA('D')
CALL setdir(bbspath'EmailFiles/'name)
ADDRESS COMMAND 'C:List >*' mailfile 'DATES'
SAY ' Attached file:' pen3||mailfile||def
junk=getinput(1 1 'Leave file in your EmailFiles? (Ny) > ')
IF junk='Y' THEN mailfile=''
ELSE
DO
junk=getinput(1 1 'Deleting Mail will also delete file. Copy somewhere now? (Ny) > ')
IF junk='Y' THEN
DO
savearg=arg
arg=mailfile
CALL dload()
arg=savearg
END
CALL setdir(curdir)
END
END
IF readname~='NEW_FILES' & readname~='FILELISTS_REPORT' & readname~='INACTIVE_USERS' & LEFT(readname,3)~='MSG' & LEFT(readname,6)~='BBBBS.' THEN
DO
tempchar='A'
DO WHILE tempchar='A'
tempchar=getinput(1 1 '['pen3'A'def']gain ['pen3'C'def']ontinue ['pen3'R'def']eply? (acR) > ')
IF tempchar='' THEN tempchar='R'
IF tempchar='A' THEN CALL seelines(1)
END
IF tempchar='R' THEN
DO
IF WORDS(lynes.4)<2 THEN replysubj='NONE'
ELSE replysubj=SUBSTR(lynes.4,WORDINDEX(lynes.4,2))
CALL editor('MAIL' uname)
replysubj=''
END
END
IF LEFT(readname,6)~='BBBBS.' THEN
DO
tempchar='A'
DO WHILE tempchar='A'
tempchar=getinput(1 1 'Forward mail from'pen3 uname def'to other users? (aNy) > ')
IF tempchar='A' THEN CALL seelines(1)
END
IF tempchar='Y' THEN
DO
IF selectchosen(1 pen3'Forward Email To: 'def)=0 THEN
DO ei=1 TO thechosen.0 WHILE thechosen.ei~=''
CALL MAKEDIR(bbspath'EMail/'thechosen.ei)
forwardarg=bbspath'Email/'thechosen.ei'/'readname
ADDRESS COMMAND 'C:COPY' bbspath'Email/'name'/'readname forwardarg
CALL readlines(forwardarg 1)
lynes.1=lynes.1' Forwarded to you by' name TIME('C') DATE()
CALL DELETE(forwardarg)
CALL savelines(forwardarg)
IF WORDS(lynes.2)>3 THEN
DO
forname=bbspath'EmailFiles/'name'/'WORD(lynes.2,4)
IF EXISTS(forname) THEN
DO
CALL MAKEDIR(bbspath'EmailFiles/'thechosen.ei)
ADDRESS COMMAND 'C:COPY' forname bbspath'EmailFiles/'thechosen.ei
END
END
line='Mail' pen3||readname||def 'forwarded to' pen3||thechosen.ei||def
IF emailonline>=0 THEN emailonline=emailonline+1
SAY line
END
END
END
tempchar=''
tempstr='Delete the mail ('pen3||delnum||def') from'pen3 uname def'that you just read?'
IF mailfile='' THEN tempchar=getinput(1 1 tempstr '(nqY) > ')
ELSE
DO WHILE tempchar~='N' & tempchar~='Q' & tempchar~='Y'
tempchar=getinput(1 1 tempstr '(nqy) > ')
END
IF tempchar='Q' THEN
DO
IF getinput(1 1 'Quit reading your Email? (Ny) > ')='Y' THEN
DO
readname=''
uname=''
RETURN
END
END
ELSE IF tempchar~='N' THEN
DO
dirname=bbspath'Email/'name'/'
nodelete=0
IF bbsprefs.14=1 & name~=sysop & uname~=sysop & WORD(lynes.2,2)~='BBBBS' & WORD(lynes.2,2)~=sysop & WORD(lynes.3,2)~=sysop THEN
nodelete=1
IF nodelete THEN
ADDRESS COMMAND 'C:Copy' dirname||readname bbspath'Email/'sysop
ELSE emailonline=emailonline-1
CALL DELETE(dirname||readname)
tempstr='Old email'
IF mailfile~='' & readname~='NEW_FILES' & readname~='FILELISTS_REPORT' & readname~='INACTIVE_USERS' & EXISTS(bbspath'EmailFiles/'name'/'mailfile) THEN
DO
IF nodelete THEN
ADDRESS COMMAND 'C:Copy' bbspath'EmailFiles/'name'/'mailfile bbspath'EmailFiles/'sysop
CALL DELETE(bbspath'EmailFiles/'name'/'mailfile)
CALL DELETE(bbspath'EmailFiles/'name'/'mailfile'.xdl')
tempstr=tempstr 'and attached file'
END
tempstr=tempstr 'deleted. Thank you for keeping a clean BBS!'
SAY tempstr
IF tempchar='Q' THEN
IF getinput(1 1 'Quit reading your Email? (Ny) > ')='Y' THEN
DO
readname=''
uname=''
RETURN
END
END
ELSE IF LEFT(readname,3)='MSG' & level>sysoplevel THEN
DO
ii=LEFT(readname,POS('.',readname)-1)
ii=SUBSTR(ii,4)%1
IF getinput(1 1 'Move this message back to the' msg.ii 'conference? (nY) > 'def)~='N' THEN
DO
temp=TRANSLATE(readname,'/','.')
temp=SUBSTR(temp,4)
lynes.1='!!'STRIP(lynes.1)
edtype=''
CALL savelines(msgpath||temp)
CALL DELETE(bbspath'Email/'name'/'readname)
END
END
ELSE IF LEFT(readname,3)~='MSG' & readname~='NEW_FILES' & readname~='FILELISTS_REPORT' & readname~='INACTIVE_USERS' THEN
DO
arg=bbspath'Email/'name'/'readname
CALL readlines(arg 1)
IF WORDS(lynes.5)<7 THEN
DO
lynes.5=lynes.5' (Rcvd)' DATE('W') DATE() TIME('C')
CALL DELETE(arg)
CALL savelines(arg)
SAY 'Email has been marked as received.'
END
END
readname=''
uname=''
arg=''
END
IF nomail THEN
DO
SAY 'No mail was found.'
CALL waiting()
END
CALL setdir(libpath||dirs.1)
thechosen.=''
RETURN
selectchosen:
PARSE ARG startat selectline
IF startat<2 THEN thechosen.=''
line='Enter list of comma separated user names'
IF level>sysoplevel THEN line=line 'or ALL'
SAY line
thechosen.startat=getinput(1 0 selectline' ')
IF STRIP(thechosen.startat)='' THEN RETURN 1
thechosen.startat=SPACE(thechosen.startat,1,'_')
thechosen.0=startat
IF level>sysoplevel & thechosen.startat='ALL' THEN
thechosen.startat=SHOWDIR(bbspath'Users','F',',')
IF POS(',',thechosen.startat)>0 THEN
DO
temp=TRANSLATE(thechosen.startat,' ',',')
thechosen.0=thechosen.0+WORDS(temp)-1
DO ei=1 TO WORDS(temp)
eii=startat+ei-1
thechosen.eii=STRIP(WORD(temp,ei))
END
END
DO ei=startat TO thechosen.0
DO WHILE FIND(userlist,thechosen.ei)=0
IF thechosen.ei~='' THEN
DO
IF FIND(exclusion,thechosen.ei)>0 | thechosen.ei='BBBBS' THEN
DO
thechosen.ei=sysop
ITERATE ei
END
CALL loadcourtesy()
IF FIND(courtesy,thechosen.ei)>0 THEN ITERATE ei
END
SAY thechosen.ei 'not found! Enter that name again or press RETURN.'
thechosen.ei=getinput(1 0 pen3||selectline' 'def)
IF thechosen.ei='' THEN
DO
IF getinput(1 1 'Do you want to see the list of current users? (Ny) > ')='Y' THEN
CALL showuserlist()
ITERATE ei
END
thechosen.ei=SPACE(thechosen.ei,1,'_')
END
END
RETURN 0
countcheck:
PARSE ARG fname' 'cknum' '.
IF ~EXISTS(fname) THEN
DO
IF cknum=0 THEN RETURN 0
IF ~writeopen(fname) THEN RETURN 0
CALL WRITELN(f,cknum)
CALL CLOSE(f)
RETURN cknum
END
IF ~readopen(fname) THEN RETURN cknum
retval=STRIP(READLN(f))
CALL CLOSE(f)
IF ~DATATYPE(retval,'W') THEN retval=0
IF ~DATATYPE(cknum,'W') THEN cknum=0
IF retval<cknum THEN
DO
IF writeopen(fname) THEN
DO
CALL WRITELN(f,cknum)
CALL CLOSE(f)
RETURN cknum
END
END
RETURN retval
pickfromlist:
DO pfl=1 TO picklist.0 BY 3
pfl2=pfl+1
pfl3=pfl+2
pfline=pen3||RIGHT(pfl,3)||def LEFT(picklist.pfl,21)
IF picklist.pfl2~='' THEN
pfline=pfline pen3||RIGHT(pfl2,3)||def LEFT(picklist.pfl2,21)
IF picklist.pfl3~='' THEN
pfline=pfline pen3||RIGHT(pfl3,3)||def LEFT(picklist.pfl3,21)
SAY pfline
END
emnum=getinput(1 0 pen3'Select Email Number > 'def)
IF ~DATATYPE(emnum,'W') | emnum<1 | emnum>picklist.0 THEN RETURN 0
RETURN emnum
sysED:
IF level<99 THEN RETURN
arg=getinput(0 0 'Textfile To Edit: ')
IF arg='' THEN RETURN
CALL bbsED(1 arg)
RETURN
bbsED:
PARSE ARG firstedit editarg .
notchanged=1
IF readlines(editarg 1) THEN RETURN 1
finfo=STATEF(editarg)
IF WORDS(finfo)>7 THEN finfo=SUBSTR(finfo,WORDINDEX(finfo,8))
ELSE finfo=''
SAY
SAY ' 'pen3'Entering the EDITOR module..'def
SAY
count=1
DO edloop=1
IF edcom='S' & bbsprefs.5 THEN /* spell check */
DO
SAY pen3'You must use ['def'R'pen3']eplace to make corrections. 'pen2'Spellchecking...'def
CALL DELETE(scratch'/SpellLOCAL')
CALL savelines(scratch'/SpellLOCAL')
curdir=PRAGMA('D')
CALL setdir(spellpath)
CALL SpellChk.rexx(scratch'/SpellLOCAL')
CALL setdir(curdir)
END
ELSE
DO
IF edcom='R' | edcom='I' | edcom='L' THEN CALL wrapbuf(7)
IF edcom~='L' THEN count=count-linesperpage
IF count>=lynes.0 | count<1 THEN count=1
startcount=count
DO i=startcount TO lynes.0+1
IF ((i+1-startcount)//linesperpage)=0 THEN
DO
pline=' ['pen3'E'def']dit'
pline=pline ' ['pen3'RETURN'def']=Continue '
edcom=getinput(1 1 pline)
IF edcom~='' THEN LEAVE i
CALL cleanline(1)
END
SAY pen3||RIGHT(i,2)||def lynes.i
count=count+1
END
END
SAY lineup' ['pen3'A'def']ppend ['pen3'C'def']ut ['pen3'I'def']nsert ['pen3'K'def']ill ['pen3'?'def'] Help'
pline=' ['pen3'L'def']ist ['pen3'P'def']aste ['pen3'R'def']eplace'
IF bbsprefs.5 THEN pline=pline '['pen3'S'def']pellcheck'
pline=pline '['pen3'U'def']pload-Text > '
edcom=getinput(1 0 pline)
IF edcom='Q' | edcom='X' THEN edcom=''
IF edcom='?' THEN
DO
SAY
SAY ' Editor Help'
SAY '----------------------------------------------------------'
SAY ' an empty RETURN tells the editor you are done editing.'
SAY ' 7 edits line number 7, if it exists.'
SAY ' a Append text to this file.'
SAY ' c Cut selected line(s) of text to buffer.'
SAY ' i Insert blank line.'
SAY ' k Kill (delete) this file.'
SAY ' l List this file from selected line.'
SAY ' p Paste buffer contents to selected line number.'
SAY ' r Replace a phrase or line of text.'
SAY ' s Spellcheck this file.'
SAY ' u Upload a textfile to append to this file.'
SAY '----------------------------------------------------------'
SAY
OPTIONS PROMPT ''
PULL
END
IF edcom='K' THEN
DO
junk=getinput(1 1 'Are you' pen3'sure'def 'you want to delete' editarg'? (Ny) > ')
IF junk='Y' THEN
DO
IF DELETE(editarg)=1 THEN SAY editarg 'DELETED.'
IF WORD(lynes.1,1)='Mail:' & WORDS(lynes.2)>3 THEN
DO
IF DELETE(bbspath'EmailFiles/'WORD(lynes.3,2)'/'WORD(lynes.2,4))=1 THEN
SAY WORD(lynes.2,4) 'DELETED.'
END
RETURN 2
END
END
IF edcom='' THEN
DO
SAY ' 'pen3'Leaving the EDITOR module.'def
IF notchanged THEN RETURN 0
IF getinput(1 1 ' Save changes? (nY)'pen3' > 'def)='N' THEN
RETURN 1
CALL DELETE(editarg)
IF savelines(editarg) THEN RETURN 1
CALL DELAY(28)
IF finfo~='' THEN ADDRESS COMMAND 'C:filenote' editarg finfo
SAY pen3' Changes saved.'def
RETURN 0
END
ELSE IF edcom='C' THEN /* Cut */
DO
firstnum=getinput(1 0 ' Enter line number or range 'pen3'(5-7)'def' to cut' pen3'>'def)
IF firstnum='' THEN ITERATE edloop
dash=POS('-',firstnum)
IF dash>0 THEN
DO
lastnum=STRIP(SUBSTR(firstnum,dash+1))
firstnum=STRIP(LEFT(firstnum,dash-1))
END
ELSE lastnum=firstnum
IF ~DATATYPE(firstnum,'W') | ~DATATYPE(lastnum,'W') THEN
DO
junk=getinput(1 1 pen3'*** You must enter numbers here! 'def)
ITERATE edloop
END
IF lastnum>lynes.0 THEN lastnum=lynes.0
IF firstnum<firstedit THEN
DO
SAY '*** You are not authorized to delete that line!'
SAY
ITERATE edloop
END
IF firstnum>lastnum THEN
DO
SAY '*** Input error! First number larger than last number'
ITERATE edloop
END
notchanged=0
numdiff=lastnum+1-firstnum
pasted.=''
pasted.0=numdiff
k=0
DO i=firstnum TO lynes.0
j=i+numdiff
k=k+1
IF k<=numdiff THEN pasted.k=lynes.i
lynes.i=lynes.j
lynes.j=''
END
lynes.0=lynes.0-numdiff
count=1
END
ELSE IF edcom='A' THEN /* append */
DO
CALL writebuffer(scratch'/EditorLOCAL')
notchanged=0
END
ELSE IF edcom='U' THEN /* fileappend (upload) */
DO
frompath=GETCLIP('BBS_frompath')
IF frompath='' THEN frompath=libpath'SysOps'
farg=GetFile(150,36,frompath,'',' Select TextFile to Append ')
IF farg~='' & EXISTS(farg) THEN
DO
CALL readlines(farg lynes.0+1)
notchanged=0
CALL SETCLIP('BBS_frompath',WORD(lastslash(farg),2))
END
END
ELSE IF edcom='I' | edcom='R' | edcom='L' | edcom='P' | DATATYPE(edcom,'W') THEN
DO
IF DATATYPE(edcom,'W') THEN
DO
ednum=edcom
edcom='R'
END
ELSE
DO
line=pen3' '
IF edcom='L' | edcom='P' THEN line=line'Starting '
line=line'Line Number? > 'def
ednum=getinput(1 0 line)
END
IF ~DATATYPE(ednum,'W') THEN ITERATE edloop
IF ednum>(lynes.0+1) THEN ITERATE edloop
IF edcom='L' THEN
DO
count=ednum
ITERATE edloop
END
IF ednum=1 & UPPER(WORD(lynes.1,1))='FILE:' THEN
DO
IF getinput(1 1 pen3'Edit KeyWords:? (Ny) > 'def)='Y' THEN
DO
filenum=STRIP(WORD(lynes.1,2))
num=files.filenum.0
keywords=edkeywords(editarg)
lynes.1=LEFT(lynes.1,21) keywords
alpha.num=TRIM(OVERLAY(keywords,alpha.num,47,32))
savefileflag=1
notchanged=0
ITERATE edloop
END
END
IF ednum<firstedit THEN
DO
SAY '*** You are not authorized to alter that line!'
SAY
ITERATE edloop
END
IF edcom='R' THEN /* replace */
DO
SAY ' Now reads:'
SAY pen3||RIGHT(ednum,2)||def lynes.ednum
OPTIONS PROMPT pen3'........Search text? >'def
PARSE PULL stext
IF LENGTH(stext)=0 THEN
DO
IF getinput(1 1 lineup||pen3'Replace entire line? (nY) >'def)='N' THEN
ITERATE edloop
lynes.ednum=getinput(0 0 pen3||RIGHT(ednum,2)' 'def)
notchanged=0
ITERATE edloop
END
found=POS(UPPER(stext),UPPER(lynes.ednum))
IF found=0 THEN
DO
SAY
SAY stext' was not found!'
SAY
ITERATE edloop
END
OPTIONS PROMPT pen3'...Replacement text? >'def
PARSE PULL rtext
lynes.ednum=DELSTR(lynes.ednum,found,LENGTH(stext))
lynes.ednum=INSERT(rtext,lynes.ednum,found-1)
IF ednum<4 & LEFT(lynes.1,6)='File: ' THEN
DO
PARSE VAR lynes.1 'File: 'filenum . 'KeyWords: 'keywords
PARSE VAR lynes.3 . 'Lib:' libnam
filenum=STRIP(filenum)
newc=files.filenum.0
libnum=finddirnum(libnam)
alpha.newc=LEFT(WORD(lynes.2,2),22-LENGTH(WORD(lynes.2,4)))
alpha.newc=alpha.newc WORD(lynes.2,4) RIGHT(filenum,5)
alpha.newc=alpha.newc RIGHT(libnum,2) LEFT(STRIP(libnam),12)
alpha.newc=alpha.newc STRIP(LEFT(STRIP(keywords),32))
savefileflag=1
END
SAY 'Done.'
SAY
notchanged=0
END
ELSE IF edcom='I' THEN /* insert */
DO
DO i=lynes.0 TO ednum BY -1
j=i+1
lynes.j=lynes.i
END
lynes.ednum=''
notchanged=0
lynes.0=lynes.0+1
lynes.ednum=getinput(0 0 pen3||RIGHT(ednum,2)'>'def)
END
ELSE IF edcom='P' THEN /* paste */
DO
DO i=lynes.0 TO ednum BY -1
j=i+pasted.0
lynes.j=lynes.i
END
DO k=1 TO pasted.0
kk=ednum+k-1
lynes.kk=pasted.k
END
notchanged=0
lynes.0=lynes.0+pasted.0
END
END
END
RETURN 0
editor:
toname=''
msgnum=0
thechosen.=''
PARSE ARG edtype toname msgnum .
IF edtype='MAIL' THEN lastwrit=countcheck(bbspath'Numbers/LastMail 0')
ELSE
DO
IF edtype='MSG' THEN
DO
tempmsgdir=0
IF DATATYPE(arg,'W') THEN tempmsgdir=arg
IF tempmsgdir>0 & tempmsgdir<=level & msg.tempmsgdir~='' THEN
msgdir=tempmsgdir
ELSE IF areaselect() THEN RETURN
END
lastwrit=countcheck(bbspath'Numbers/LastMessage'msgdir 0)
END
IF toname='' THEN
DO
IF edtype='MAIL' THEN
DO
CALL selectchosen(1 pen3'Send PRIVATE' edtype lastwrit+1 'To: 'def)
toname=thechosen.1
END
ELSE toname=getinput(1 0 pen3'Post A PUBLIC Message To: 'def)
END
toname=SPACE(STRIP(UPPER(toname)),1,'_')
toname=COMPRESS(toname,'.,:/*#?^ ')
IF toname='' | FIND(exclusion,toname)>0 THEN
DO
IF toname='' & edtype='MSG' THEN toname='ALL'
ELSE toname=sysop
SAY pen3'*** Re-Addressed to'def toname
END
IF toname~='ALL' THEN
DO
IF toname='BBBBS' THEN toname=sysop
IF FIND(userlist,toname)=0 THEN
DO
IF courtesy='' THEN CALL loadcourtesy()
IF FIND(courtesy,toname)=0 THEN
DO
SAY
SAY bak2' 'toname' is not on the user list! 'def
IF edtype='MAIL' THEN
DO
CALL showuserlist()
RETURN 0
END
ELSE
DO
IF getinput(1 1 'Do you want to use it anyway? (nY) > ')='N' THEN
DO
IF getinput(1 1 'Do you want to see the list of current users? (Ny) > ')='Y' THEN
CALL showuserlist()
RETURN 0
END
END
END
END
END
IF edtype='MAIL' THEN
DO
CALL MAKEDIR(bbspath'EMail/'toname)
mailname=bbspath'EMail/'toname'/'name'.'lastwrit+1
END
ELSE
DO
CALL MAKEDIR(msgpath||msgdir)
mailname=msgpath||msgdir'/'lastwrit+1
END
lynes.=''
lynes.0=6
IF edtype='MAIL' THEN lynes.1=' Mail:' lastwrit+1 /* FILE: filename */
ELSE lynes.1=' Msg:' lastwrit+1 /* Msg: MSG# REPLY # # ... */
lynes.2=' From:' name
IF city~='' THEN lynes.2=lynes.2' - 'city
lynes.3=' To:' toname /* To: toname MSG # */
IF edtype='MAIL' THEN
DO
IF readopen(bbspath||'Users/'toname) THEN
DO
CALL READLN(f)
CALL READLN(f)
temp=READLN(f)
CALL CLOSE(f)
temp=docity(temp)
IF temp~='' THEN lynes.3=lynes.3' - 'temp
END
IF replysubj='|@NEW@|' THEN
DO
CALL readlines(bbspath'BBS_TEXT/EMAIL_WELCOME' 7)
replysubj='Welcome to' bbsname
END
END
subj=''
IF edtype='REPLY' THEN
DO
subj=SUBSTR(forthline,WORDINDEX(forthline,2))
SAY pen3'Subj:'def subj
temp=getinput(0 0 'Change the current subject? (Ny) > ')
IF LENGTH(temp)>3 THEN subj=temp
ELSE IF LEFT(UPPER(temp),1)='Y' THEN subj=''
END
ELSE IF edtype='MAIL' & replysubj~='' THEN subj=replysubj
IF subj='' THEN
DO
IF opt='C' THEN subj='FEEDBACK'
ELSE
DO
SAY pen3'Enter the'def 'Subject' pen3'of this message (1 line).'def
subj=getinput(0 0 pen3': 'def)
END
END
IF LENGTH(subj)>66 THEN subj=LEFT(subj,66)
IF subj='' THEN subj='?'
lynes.4=' Subj:' subj
lynes.5=' Date:' DATE('W') DATE()' 'TIME('C')
IF edtype~='MAIL' THEN lynes.5=LEFT(lynes.5,39) 'Conference:' msg.msgdir
lynes.6=LEFT('',74,'=')
IF edtype='REPLY' THEN lynes.3=lynes.3' MSG 'msgnum
DO i=1 TO lynes.0
SAY lynes.i
END
CALL writebuffer(scratch'/MessageLOCAL')
IF savelines(mailname) THEN RETURN 0
CALL seelines(1)
IF thechosen.0='' THEN
DO
thechosen.0=1
thechosen.1=toname
END
carbons=thechosen.0+1
DO FOREVER
IF thechosen.0>=carbons THEN
DO
junk='Copies To:'
DO cci=carbons TO thechosen.0
junk=junk thechosen.cci
END
SAY junk
END
pline=''
IF edtype='MAIL' THEN pline='['pen3'C'def']opies'
pline=STRIP(pline '['pen3'E'def']dit ['pen3'K'def']ill ['pen3'R'def']ead')
pline=pline '['pen3'U'def']pload-Text ['pen3'S'def']end' edtype'? (ekrSu) 'def
junk=getinput(1 1 pline)
IF junk='E' THEN
DO
IF level>sysoplevel THEN firstedit=1
ELSE firstedit=7
IF bbsED(firstedit mailname)=2 THEN RETURN 0
junk='R'
END
ELSE IF edtype='MAIL' & junk='C' THEN
DO
CALL selectchosen(carbons pen3'Carbon Copies To: 'def)
junk='R'
END
ELSE IF junk='K' THEN
DO
IF DELETE(mailname)=1 THEN SAY edtype 'DELETED.'
RETURN 0
END
ELSE IF junk='U' THEN
DO
SAY 'Ready to append' pen3'TEXT ONLY'def
pline='Are you SURE your file is un-compressed text? (Ny) > '
IF getinput(1 1 pline)='Y' THEN
DO
arg='UploadLOCAL'
curdir=PRAGMA('D')
CALL setdir(scratch)
CALL DELETE(arg)
CALL DELETE('tempLOCAL')
IF uload(0)=0 THEN
DO
ADDRESS COMMAND 'C:copy' mailname 'tempLOCAL'
CALL DELETE(mailname)
ADDRESS COMMAND 'C:join tempLOCAL UploadLOCAL AS' mailname
END
CALL setdir(curdir)
END
junk='R'
END
IF junk='R' THEN
DO
CALL readlines(mailname 1)
CALL seelines(1)
nonstop=0
END
ELSE BREAK
END
IF edtype='MAIL' THEN
DO
IF replysubj~='' & readname~='' & LEFT(readname,5)~='BBBBS' & uname~='' & uname~='UNAME' THEN
DO
junk=getinput(1 1 'Attach original mail from' uname'? (nY) > ')
IF junk~='N' THEN
DO
arg=bbspath'Email/'name'/'readname
IF ~readlines(arg 1) THEN CALL savelines(mailname)
END
END
junk=getinput(1 1 pen3'Attach a file to this message? (Ny) > 'def)
IF junk='Y' THEN
DO
savearg=arg
arg=''
curdir=PRAGMA('D')
CALL MAKEDIR(bbspath'EmailFiles/'toname)
CALL setdir(bbspath'EmailFiles/'toname)
IF uload(0)=0 THEN
DO
IF WORD(STATEF(bbspath'EmailFiles/'toname'/'arg),2)>1 THEN
DO
CALL readlines(mailname 1)
IF arg~='' THEN lynes.1=lynes.1' FILE: 'arg
CALL setdir(curdir)
CALL DELETE(mailname)
CALL savelines(mailname)
END
END
ELSE
DO
CALL DELETE(bbspath'EmailFiles/'toname'/'arg)
SAY pen3'*** Upload failed! ***'def
END
arg=savearg
END
totmail=WORD(data.17,2)
IF ~DATATYPE(totmail,'W') THEN totmail=1
ELSE totmail=totmail+1
data.17=WORD(data.17,1)' 'totmail' 'WORD(data.17,3)
END
IF edtype~='MAIL' THEN totwrit.msgdir=totwrit.msgdir+1
CALL readlines(mailname 1)
DO ui=1 TO thechosen.0
IF thechosen.ui='' THEN ITERATE ui
IF ui>1 THEN
DO
CALL MAKEDIR(bbspath'Email/'thechosen.ui)
newname=bbspath'Email/'thechosen.ui'/'name'.'lastwrit+1
IF ui<carbons THEN lynes.3=' To:' thechosen.ui
ELSE
DO
lynes.1=lynes.1' (Carbon Copy)'
lynes.3=' To:' thechosen.1
END
CALL savelines(newname)
IF WORDS(lynes.1)>3 & EXISTS(bbspath'EmailFiles/'thechosen.1'/'WORD(lynes.1,4)) THEN
DO
CALL MAKEDIR(bbspath'EmailFiles/'thechosen.ui)
ADDRESS COMMAND 'C:COPY' bbspath'EmailFiles/'thechosen.1'/'WORD(lynes.1,4) bbspath'EmailFiles/'thechosen.ui
line2='Copied' WORD(lynes.1,4)
SAY line2 'to the' thechosen.ui 'file area.'
END
END
IF edtype~='MAIL' THEN
DO
IF FIND(userlist,thechosen.ui)>0 THEN
CALL msgmark(thechosen.ui msgdir lastwrit+1)
END
IF GETCLIP('BBS_level')~='' & WORD(GETCLIP('BBS_lastcaller'),1)=thechosen.ui THEN
DO
temp='new Email.'
IF edtype~='MAIL' THEN
temp='a new message addressed to you in the'pen3 msg.msgdir def'conference.'
oldmess=GETCLIP('BBS_MESSAGE')
IF oldmess~='' THEN oldmess=oldmess||'0D0A'x
CALL SETCLIP('BBS_MESSAGE',oldmess||'You have' temp)
END
line=edtype 'Sent To' thechosen.ui
IF edtype='MAIL' THEN
DO
IF emailonline>=0 THEN emailonline=emailonline+1
END
ELSE
DO
grand=grand+1
IF ~DATATYPE(msg.msgdir.0,'W') THEN msg.msgdir.0=1
ELSE msg.msgdir.0=msg.msgdir.0+1
line=line 'in the'pen3 msg.msgdir def'conference.'
END
SAY line
END
IF edtype='MAIL' THEN CALL countcheck(bbspath'Numbers/LastMail' lastwrit+1)
ELSE CALL countcheck(bbspath'Numbers/LastMessage'msgdir lastwrit+1)
CALL setdir(libpath||dirs.1)
thechosen.=''
RETURN 1
msgmark:
PARSE ARG markname markdir markmsg .
IF OPEN(f,bbspath'Users/'markname,'R')=0 THEN RETURN
mlines.=''
DO mi=1
temp=READLN(f)
IF EOF(f) THEN LEAVE mi
mlines.mi=STRIP(temp)
END
CALL CLOSE(f)
mlines.0=mi-1
CALL DELAY(28)
mlines.24=STRIP(mlines.24 markdir'/'markmsg)
IF OPEN(f,bbspath'Users/'markname,'W')=0 THEN RETURN
DO mi=1 TO mlines.0
CALL WRITELN(f,mlines.mi)
END
CALL CLOSE(f)
RETURN
shell:
SAY
olddir=PRAGMA('D')
DO WHILE(UPPER(opt)~='EXIT')
SAY bak2||TIME('C')||def PRAGMA('D')
OPTIONS PROMPT pen3'Type EXIT to quit AmigaDOS> 'def
PARSE PULL opt' 'arg
IF(UPPER(opt)='CD') THEN CALL setdir(arg)
ELSE IF exists(opt)~=0 THEN
DO
IF LEFT(STATEF(opt),3)='DIR' THEN CALL setdir(opt)
END
ELSE IF opt~='' & UPPER(opt)~='EXIT' THEN
ADDRESS COMMAND opt '<* >*' arg
END
CALL PRAGMA('D',olddir)
RETURN
bbsspace:
ARG tabspace .
ADDRESS COMMAND 'C:info >ram:locinfout' bbsdevice
ok=OPEN(f,'ram:locinfout','R')
IF ok=0 THEN RETURN 20
line=READLN(f)
line=READLN(f)
line=READLN(f)
line=READLN(f)
CALL CLOSE(f)
IF tabspace<14 THEN SAY
bbsk=WORD(line,4)
IF ~DATATYPE(bbsk,'N') THEN
DO
line=bbsdevice 'is not an info compatible device!'
SAY pen3||line||def
bbsk=0
RETURN
END
bbsk=bbsk*512-SYSTEM_SPACE_LIMIT
IF bbsk<1 THEN bbsk=0
SAY RIGHT(comma(bbsk),tabspace) 'bytes available for uploads.'
RETURN
comma:
ARG num .
dgt=LENGTH(num)
numtext=''
IF dgt>3 THEN numtext=','RIGHT(num,3)
IF dgt>6 THEN numtext=','LEFT(RIGHT(num,6),3)||numtext
IF dgt>9 THEN numtext=','LEFT(RIGHT(num,9),3)||numtext
IF dgt>12 THEN
DO
numtext=','LEFT(RIGHT(num,12),3)||numtext
numtext=LEFT(num,dgt-12)||numtext
END
ELSE IF dgt>9 THEN numtext=LEFT(num,dgt-9)||numtext
ELSE IF dgt>6 THEN numtext=LEFT(num,dgt-6)||numtext
ELSE IF dgt>3 THEN numtext=LEFT(num,dgt-3)||numtext
ELSE numtext=num
RETURN numtext
is_here:
ARG newname
SAY 'Checking filelist...'
DO wi=1 TO 99
IF wi//3=0 THEN CALL WRITECH(STDOUT,'.')
IF dirs.wi='' THEN ITERATE wi
IF ~EXISTS(bbspath'FileNotes/'dirs.wi'/'newname) THEN ITERATE wi
line=pen3'*** File' newname 'already exists here'
IF wi<=level THEN line=line 'in the' dirs.wi 'directory'
line=line'.'def
SAY line
SAY 'Original uploader should ['pen3'K'def']ill the file before uploading the replacement.'
CALL waiting()
RETURN 1
END
CALL cleanline(1)
RETURN 0
uload:
ARG frommenu
CALL bbsspace(12)
SAY
IF bbsk<1 THEN
DO
SAY pen3'Upload area is full!'def
RETURN 1
END
IF arg='' THEN
DO
frompath=GETCLIP('BBS_frompath')
IF frompath='' THEN frompath=libpath'SysOps'
fdir=''
fromfile=GetFile(150,36,frompath,'',' Select File to Upload ')
IF fromfile='' THEN RETURN 1
x=LASTPOS('/',fromfile)
IF x=0 THEN x=POS(':',fromfile)
IF x>0 THEN
DO
arg=SUBSTR(fromfile,x+1)
fdir=LEFT(fromfile,x)
IF RIGHT(fdir,1)='/' THEN fdir=LEFT(fdir,x-1)
CALL SETCLIP('BBS_frompath',fdir)
END
ELSE arg=fromfile
END
ELSE fromfile=PRAGMA('D')'/'arg
arg=COMPRESS(arg,' :/,;|#?*()+[]"{}') /* be sure no illegals here */
x=LASTPOS('/',arg)
IF x=0 THEN x=LASTPOS(':',arg)
IF x>0 THEN
DO
IF DATATYPE(SUBSTR(arg,x+1),'W') THEN
DO
SAY 'Whole numbers are not allowed as filenames!'
CALL waiting()
RETURN 1
END
END
tempnum=LENGTH(arg)-16
DO WHILE tempnum>0 & POS('EMAILFILES',UPPER(PRAGMA('D')))=0
temp=' 'pen3||arg def'is'pen3 tempnum||def
IF tempnum=1 THEN temp=temp 'character'
ELSE temp=temp 'characters'
temp=temp 'too long for a filename.'
SAY temp
arg=getinput(0 0 'Filename: ')
arg=cleanstring('0:'arg)
arg=COMPRESS(arg,' :/,;|#?*')
tempnum=LENGTH(arg)-16
END
IF arg='' THEN RETURN 1
IF frommenu THEN
DO
IF is_here(arg) THEN RETURN 1
IF bbsprefs.6=1 & sysoplevel>level THEN CALL setdir(libpath'Sysops')
ELSE
DO
SAY 'Please select an appropriate library for -' pen3||arg def'-'
IF chdir()>0 THEN RETURN
END
END
ADDRESS COMMAND 'C:COPY' fromfile PRAGMA('D')'/'arg
IF TestArc.rexx(PRAGMA('D')'/'arg)>0 THEN
DO
SAY
SAY pen3'***'def arg pen3'failed archive check!'def
SAY
temp=getinput(1 1 'Do you believe the archive checker made a mistake? (Ny) > ')
IF temp~='Y' THEN
DO
CALL DELETE(arg)
SAY
RETURN 2
END
END
IF POS('EMAILFILES',UPPER(PRAGMA('D')))>0 THEN RETURN 0
DO ui=sysoplevel+2 TO 100
IF UPPER(dirs.ui)=UPPER(plaindir) THEN RETURN 0
END
IF frommenu THEN
DO WHILE editnote(bbspath'FileNotes/'plaindir'/'arg) /* INSIST on a filenote */
END
RETURN 0
findfiles:
PARSE ARG ffile .
IF POS('EMAILFILES',UPPER(PRAGMA('D')))>0 THEN RETURN ffile
wi=0
IF DATATYPE(ffile,'W') THEN
DO
IF WORDS(files.ffile)<2 THEN RETURN 0
dirtemp=WORD(files.ffile,1)
IF finddirnum(dirtemp)>level | FIND(data.21,UPPER(dirtemp))>0 THEN
DO
CALL illegal_access()
RETURN 0
END
CALL setdir(libpath||dirtemp)
END
ELSE IF EXISTS(ffile) THEN
DO
IF EXISTS(bbspath'FileNotes/'plaindir'/'ffile) THEN
DO
IF readopen(bbspath'FileNotes/'plaindir'/'ffile)~=0 THEN
DO
line=READLN(f)
CALL CLOSE(f)
ffile=WORD(line,2)
END
END
END
ELSE IF EXISTS(bbspath'Information'ffile) THEN
RETURN bbspath'Information/'ffile
ELSE
DO
nextfilenum=countcheck(bbspath'Numbers/LastFile' 0)+1
CALL busywait(4 1)
DO ni=nextfilenum TO 0 BY -1
IF ni<1 THEN
DO
CALL busywait(4 0)
SAY '***' files.0 'filenames scanned,'pen3 ffile def'was not found!'
RETURN 0
END
IF ni>1 THEN CALL busywait(60 ni nextfilenum)
argtemp=WORD(files.ni,2)
IF UPPER(argtemp)=UPPER(ffile) THEN
DO
dirtemp=WORD(files.ni,1)
jj=files.ni.0
IF WORD(alpha.jj,4)>level | FIND(data.21,UPPER(dirtemp))>0 THEN
DO
CALL busywait(4 0)
CALL illegal_access()
RETURN 0
END
ffile=ni
CALL setdir(libpath||dirtemp)
LEAVE ni
END
END
CALL busywait(4 0)
END
ftemp=ffile
IF DATATYPE(ftemp,'W') THEN ftemp=WORD(files.ftemp,2)
IF ~EXISTS(ftemp) THEN
DO
finfo=STATEF(bbspath'FileNotes/'plaindir'/'ftemp)
IF WORDS(finfo)>7 THEN ftemp=WORD(finfo,8)
IF ~EXISTS(ftemp) THEN
DO
IF finfo='' THEN SAY '***'pen3 PRAGMA('D')'/'ftemp def'was not found!'
ELSE
DO
SAY
SAY '***'pen3 plaindir'/'ftemp def'is not currently available online.'
SAY 'Please leave email to your sysop'pen3 sysop||def', to receive this file.'
SAY
END
RETURN 0
END
END
RETURN ffile
illegal_access:
SAY
SAY '*** You are not authorized to access' ffile'!'
SAY '*** Send Email to' sysop 'to receive a higher level.'
SAY
RETURN
ext_dload:
SAY
arg=bbsExtDL.baud(name level TRUNC(maxtime-TIME('E')) linesperpage colorflag extdevs)
IF arg~='' THEN SAY 'Sorry, LOCAL mode cannot download from the Extra Devices.'
RETURN
dload:
arg=STRIP(arg data.25)
data.25=''
errorflag=0
curdir=PRAGMA('D')
OPTIONS PROMPT 'Filename and/or number: '
IF arg='' THEN PARSE PULL arg /* no filename given */
IF arg='' THEN RETURN 0
IF findfiles(arg)=0 THEN RETURN 0
arg=TRANSLATE(arg,' ',':/')
IF WORDS(arg)>1 THEN arg=WORD(arg,1)
IF DATATYPE(arg,'W') THEN
DO
CALL setdir(libpath||WORD(files.arg,1))
arg=WORD(files.arg,2)
END
IF arg~='' THEN /* check for filename */
DO dloadloop=1
frompath=GETCLIP('BBS_frompath')
IF frompath='' THEN frompath=libpath'SysOps/'
notename=bbspath'FileNotes/'plaindir'/'arg
IF ~EXISTS(arg) THEN
DO
finfo=STATEF(notename)
IF WORDS(finfo)>7 THEN
DO
temp=plaindir
x=lastslash(WORD(finfo,8))
arg=WORD(x,1)
CALL setdir(WORD(x,2))
plaindir=temp
END
END
topath=PRAGMA('D')
num=LASTPOS('/',arg)
IF num=0 THEN num=LASTPOS(':',arg)
IF num>0 THEN
DO
topath=LEFT(arg,num)
arg=SUBSTR(arg,num+1)
END
IF RIGHT(topath,1)~=':' & RIGHT(topath,1)~='/' THEN topath=topath'/'
SAY ' Select Filename to Copy ' topath||arg 'To:'
tofile=GetFile(150,36,frompath,arg,' Select Destination Name ')
IF tofile='' THEN
DO
errorflag=1
LEAVE dloadloop
END
ADDRESS COMMAND 'C:Copy' topath||arg tofile
CALL SETCLIP('BBS_frompath',WORD(lastslash(tofile),2))
IF POS('EMAILFILES',UPPER(PRAGMA('D')))>0 THEN LEAVE dloadloop
DO di=sysoplevel+2 TO 100
IF UPPER(dirs.di)=UPPER(plaindir) THEN LEAVE dloadloop
END
IF readlines(notename 1) THEN LEAVE dloadloop
dls=WORD(lynes.2,7)
IF ~DATATYPE(dls,'W') THEN dls=0
lynes.2=STRIP(DELWORD(lynes.2,7,1)) dls+1
finfo=STATEF(notename)
IF WORDS(finfo)>7 THEN finfo=SUBSTR(finfo,WORDINDEX(finfo,8))
ELSE finfo=''
CALL DELETE(notename)
CALL savelines(notename)
CALL DELAY(28)
IF finfo~='' THEN ADDRESS COMMAND 'C:FileNote' notename finfo
LEAVE dloadloop
END
CALL setdir(curdir)
IF errorflag THEN SAY pen3'*** Download Failed!'def
RETURN errorflag
lastslash:
PARSE ARG sarg
sdir=''
slash=LASTPOS('/',sarg)
IF slash>2 THEN sdir=LEFT(sarg,slash-1)
ELSE
DO
slash=LASTPOS(':',sarg)
IF slash>0 THEN sdir=LEFT(sarg,slash)
END
IF slash>0 THEN sarg=SUBSTR(sarg,slash+1)
RETURN sarg sdir
editnote:
IF arg='' THEN
DO
PARSE PULL arg .
IF arg='' THEN RETURN 0
END
comment=''
IF ~EXISTS(arg) THEN
DO
finfo=STATEF(bbspath'FileNotes/'plaindir'/'arg)
fromarg=arg
fromdir=GETCLIP('BBS_frompath')
IF WORDS(finfo)>7 THEN
DO
temp='Y'
fromdir=WORD(finfo,8)
fromdir=lastslash(fromdir)
fromarg=WORD(fromdir,1)
fromdir=WORD(fromdir,2)
END
ELSE
DO
IF level<sysoplevel THEN RETURN 0
temp=getinput(1 1 'Is this file on an another device? (Nqy)')
END
IF fromdir='' THEN fromdir=libpath'Sysops'
IF temp='Y' THEN
DO WHILE comment=''
comment=GetFile(150,36,fromdir,fromarg,' Select Linked File ')
IF comment='' THEN RETURN 0
IF ~EXISTS(comment) THEN comment=''
ELSE CALL SETCLIP('BBS_frompath',WORD(lastslash(comment),2))
END
ELSE IF temp~='N' THEN RETURN 0
END
IF comment='' THEN
DO
arg=findfiles(arg)
IF arg=0 THEN RETURN 0
IF DATATYPE(arg,'W') THEN arg=WORD(files.arg,2)
END
filedir=plaindir
slash=LASTPOS('/',arg)
IF slash=0 THEN slash=LASTPOS(':',arg)
IF slash>0 THEN
DO
filedir=LEFT(arg,slash-1)
filedir=SUBSTR(filedir,5)
arg=SUBSTR(arg,slash+1)
END
ELSE filedir=plaindir
CALL MAKEDIR(bbspath'FileNotes/'filedir)
IF ~EXISTS(bbspath'FileNotes/'filedir) THEN
DO
SAY pen3'*** Failed to open directory!' filedir||def
RETURN 0
END
notename=bbspath'FileNotes/'filedir'/'arg
lynes.=''
filenum=countcheck(bbspath'Numbers/LastFile' 0)
IF level>sysoplevel THEN firstedit=1
ELSE firstedit=5
IF EXISTS(notename) THEN
DO
IF comment~='' THEN ADDRESS COMMAND 'C:filenote' notename comment
CALL bbsED(firstedit notename)
RETURN 0
END
IF comment='' THEN filedata=STATEF(libpath||filedir'/'arg)
ELSE filedata=STATEF(comment)
IF filedata='' THEN
DO
IF comment='' THEN line=filedir'/'arg
ELSE line=comment
SAY line 'does not exist!'
RETURN 0
END
bytes=WORD(filedata,2)
filenum=filenum+1
lynes.0=4
lynes.1='File: 'LEFT(filenum,5)' KeyWords:'
lynes.2='Name: 'LEFT(arg,27)' Size: 'bytes' bytes Downloads: 0'
lynes.3='From: 'LEFT(name,27)' Date: 'DATE() TIME('C')' Lib: 'filedir
lynes.4=LEFT('',74,'=')
lynes.1=lynes.1 edkeywords(arg filedir)
CALL seelines(1)
edtype=''
CALL writebuffer(scratch'/NoteLOCAL')
IF savelines(notename) THEN RETURN 0
IF comment~='' THEN ADDRESS COMMAND 'C:filenote' notename comment
fncom='R'
DO WHILE fncom='R'
CALL seelines(1)
nonstop=0
line='['pen3'E'def']dit'
IF level>sysoplevel THEN line=line '['pen3'K'def']ill'
line=line '['pen3'R'def']ead ['pen3'S'def']ave'
IF level>sysoplevel THEN line=line '(ekrS) 'def
ELSE line=line '(erS) 'def
fncom=getinput(1 1 line)
IF fncom='K' & level>sysoplevel THEN
DO
SAY 'Killing FileNote..'
CALL DELETE(notename)
RETURN 1
END
ELSE IF fncom='E' THEN
DO
IF bbsED(firstedit notename)>0 THEN RETURN 0
fncom='R'
END
ELSE IF fncom~='R' THEN
DO
SAY 'Adjusting filelist...'
IF filenum<1 THEN filenum=1
IF GETCLIP('BBS_level')~='' THEN CALL SETCLIP('BBS_localfiles',1)
CALL countcheck(bbspath'Numbers/LastFile' filenum)
files.0=files.0+1
newcount=alpha.0+1
alpha.0=newcount
files.filenum=plaindir arg
files.filenum.0=newcount
libnum=finddirnum(plaindir)
PARSE VAR lynes.1 . 'KeyWords:' keywords
alpha.newcount=LEFT(arg,22-LENGTH(WORD(lynes.2,4)))
alpha.newcount=alpha.newcount WORD(lynes.2,4) RIGHT(filenum,5)
alpha.newcount=alpha.newcount RIGHT(libnum,2) LEFT(plaindir,12)
alpha.newcount=alpha.newcount STRIP(LEFT(STRIP(keywords),32))
IF EXISTS(bbspath'Lists/Files') THEN
x=OPEN(f,bbspath'Lists/Files','A')
ELSE x=OPEN(f,bbspath'Lists/Files','W')
IF x=0 THEN
DO
SAY '*** Failed to open' bbspath'Lists/Files'
RETURN 0
END
CALL WRITELN(f,filenum files.filenum)
CALL CLOSE(f)
IF EXISTS(bbspath'Lists/Files.ALPHA') THEN
x=OPEN(f,bbspath'Lists/Files.ALPHA','A')
ELSE x=OPEN(f,bbspath'Lists/Files.ALPHA','W')
IF x=0 THEN
DO
SAY '*** Failed to open' bbspath'Lists/Files.ALPHA'
RETURN 0
END
CALL WRITELN(f,alpha.newcount)
CALL CLOSE(f)
sortalphaflag=1
savefileflag=1
END
END
RETURN 0
edkeywords:
PARSE ARG kwarg
templine=''
DO WHILE LENGTH(templine)<3
SAY
SAY pen3'Please enter a list of keywords (or a condensed description)'def
SAY pen3'to be used in the alphabetic list and by the search routine.'def
SAY ' Note that only the first 32 characters will be used.'
SAY LEFT('',43)'|'LEFT('',31,'=')'|'
templine=getinput(0 0 ' 'RIGHT(STRIP(RIGHT(kwarg,32)),32) pen3'KeyWords: 'def)
templine=cleanstring('0:'templine)
templine=STRIP(LEFT(templine,32))
SAY
END
RETURN templine
loadfiles:
SAY def
SAY 'Loading filelist...'
files.=''
files.0=0
IF readopen(bbspath'Lists/Files') THEN
DO
DO i=1
line=READLN(f)
IF EOF(f) THEN BREAK
num=WORD(line,1)
IF DATATYPE(num,'W') THEN files.num=WORD(line,2) WORD(line,3)
END
files.0=i-1
CALL CLOSE(f)
END
RETURN
savefilelist:
IF level=99 THEN
IF getinput(1 1 'Update filelists now? (nY) > ')='N' THEN RETURN
savefilelist2:
SIGNAL OFF BREAK_E
IF ckmaint('FILES') THEN RETURN
CALL savealphalist()
SAY 'Saving filelist...'
CALL SETCLIP('BBS_maint',1)
xarg=bbspath'Lists/Files'
CALL DELETE(xarg)
filenum=countcheck(bbspath'Numbers/LastFile' 0)
IF filenum<1 | writeopen(xarg)=0 THEN RETURN
DO i=1 TO filenum
IF files.i='' THEN ITERATE
CALL WRITELN(f,i files.i)
END
CALL CLOSE(f)
CALL SETCLIP('BBS_maint')
savefileflag=0
IF SHOW('P','BBBBS') THEN CALL SETCLIP('BBS_localfiles',2)
RETURN
loadalpha:
SAY def
SAY 'Loading the alphabetical filelist...'
IF readopen(bbspath'Lists/Files.ALPHA') THEN
DO
alpha.=''
alpha.0=0
DO i=1
line=READLN(f)
IF EOF(f) THEN BREAK
fnum=WORD(line,3)
IF DATATYPE(fnum,'W') THEN
DO
alpha.i=line
files.fnum.0=i
END
ELSE i=i-1
END
CALL CLOSE(f)
alpha.0=i-1
IF alpha.0<files.0 THEN buildalpha=1
END
ELSE SAY pen3'*** Lists/Files.ALPHA failed to open for reading!'def
SAY
RETURN
ckmaint:
ARG ckfile .
IF GETCLIP('BBS_maint')~='' THEN
DO
DO i=0 TO 23 WHILE GETCLIP('BBS_maint')~=''
IF i//2=0 THEN SAY 'Waiting' (24-i)*5 'more seconds for' ckfile 'list update to finish...'
CALL DELAY(250)
END
IF i>23 THEN
DO
SAY '*** unable to update' ckfile 'list.'
RETURN 1
END
END
RETURN 0
savealphalist:
SIGNAL OFF BREAK_E
IF ckmaint('ALPHA') THEN RETURN
CALL SETCLIP('BBS_maint',1)
IF GETCLIP('BBS_mainfiles')~='' & GETCLIP('BBS_maint')='' THEN
DO
CALL SETCLIP('BBS_mainfiles')
CALL loadfiles()
CALL loadalpha()
END
aarg=bbspath'Lists/Files.ALPHA'
CALL DELETE(aarg)
IF sortalphaflag=1 THEN
DO
SAY 'Alphabetizing' alpha.0 'files...'
CALL QSORT(1,alpha.0,alpha)
DO i=1 TO alpha.0
fnum=WORD(alpha.i,3)
files.fnum.0=i
END
END
sortalphaflag=0
IF writeopen(aarg)=0 THEN
DO
SAY '*** Error opening' aarg '!'
CALL SETCLIP('BBS_maint')
RETURN
END
SAY 'Saving alphabetical filelist...'
DO i=1 TO alpha.0
ii=WORD(alpha.i,3)
IF files.ii='' THEN alpha.i='0 0' ii '100'
IF LEFT(alpha.i,4)~='0 0 ' THEN CALL WRITELN(f,alpha.i)
END
CALL CLOSE(f)
CALL SETCLIP('BBS_maint')
CALL bbsALPHA.rexx SUBSTR(extension,2) arccom
RETURN
viewuser:
SAY
SAY bak2' 'name' 'def
DO i=1 TO 18
stuff=data.i
IF i=13 | i=14 THEN stuff=DATE(,data.i,'S')
SAY RIGHT(i,2)||pen3 text.i||def':' stuff
END
CALL waiting()
RETURN
edituser:
IF getinput(1 1 'Change ['pen3'U'def']ser data or ['pen3'M'def']essage conference access (mU) > ')='M' THEN
DO
SAY
SAY pen3' - Message Conference Access -'def
SAY '[O]ff turns all message conferences OFF.'
SAY 'Set the last message read by you in ALL message conferences'
temp=getinput(1 1 ' ['pen3'L'def']ast ['pen3'F'def']irst ['pen3'O'def']ff ['pen3'Q'def']uit (fLoq) > ')
IF temp='Q' THEN RETURN
SAY 'Resetting...'lineup
data.22=''
DO i=1 TO level
IF temp='F' THEN num=0
ELSE IF temp='O' THEN num=-1
ELSE num=countcheck(bbspath'Numbers/LastMessage'i 0)
data.22=data.22 num
END
CALL SetData()
CALL sortconferences()
CALL savedata(1)
RETURN
END
new=0
change=0
edata.=''
edname=name
DO i=0 TO data.0
edata.i=data.i
END
num=1
DO WHILE num~='' | edname~=name
IF num='' | LEFT(num,1)='Q' THEN
DO
IF change THEN
DO
CALL SetData()
CALL saveData(1)
change=0
END
IF new THEN
DO
data.=''
DO i=0 TO edata.0
data.i=edata.i
END
name=edname
new=0
END
CALL SetData()
END
maxnum=10
IF edata.20>sysoplevel THEN maxnum=20
IF edata.20=99 THEN maxnum=24
SAY bak2' 'name' 'def
maxlines=21
IF maxnum=10 THEN maxlines=20
DO i=1 TO maxlines
IF i=5 & name~=edname & edata.20<99 THEN ITERATE
SAY RIGHT(i,2)||pen3 text.i||def':' data.i
END
IF edata.20>sysoplevel THEN
DO
line=LEFT(' ',50)
IF name=edname THEN line=line'NEW = Change User.'
line=pen3||line||def||lineup
SAY line
END
num=getinput(1 0 'Select Line Number To Edit: ')
IF num='NEW' & edata.20>sysoplevel & edname=name THEN /* select a new user */
DO
new=1
IF change THEN
DO
CALL SetData()
CALL saveData(1)
END
change=0
nufile=bbspath'Lists/NEW_USERS'
IF EXISTS(nufile) THEN
IF ~readlines(nufile 1) THEN CALL seelines(0)
savename=name
name=getinput(1 0 'New User Name: 'def)
name=SPACE(name,1,'_')
name=COMPRESS(name,':/*#?^')
IF loadData()=0 THEN name=savename
IF data.20>=edata.20 THEN
DO
SAY 'Can''t Edit!' pen3||name def'has an equal or higher level than thee.'
name=savename
CALL loadData()
END
END
ELSE IF DATATYPE(num,'W') & num>0 THEN
DO
IF num>maxnum THEN
DO
SAY
SAY pen3'You are not authorized to change that information!'def
SAY
END
ELSE
DO dummy=1 TO 1
IF num=8 THEN
DO
SAY
SAY 'Use spaces to seperate options.'
SAY 'If the option word is in line 8, it is ON.'
SAY 'Valid Options:'
SAY ' MENU combines all main commands into 1 menu.'
SAY ' MENUS splits main commands into 3 menus.'
SAY ' COLOR turns ANSI color codes ON.'
SAY ' PHONE makes your phone number public.'
SAY ' QUICK for long distance callers. See BBBBS.REVISION'
SAY ' STREET makes your street address public.'
SAY ' TERSE skips some of the logon procedures.'
SAY
END
line=RIGHT(num,2)||pen3 text.num||def': '
SAY line||data.num
temp=getinput(0 0 line)
IF temp='' THEN
DO
IF num=1 | num=4 | num=5 | num=6 | num=7 THEN LEAVE dummy
IF num=11 | num=12 | num=13 | num=20 THEN LEAVE dummy
END
IF num=5 | num=8 THEN temp=UPPER(temp)
IF num=20 & DATATYPE(temp,'W') & temp>=edata.20 THEN
temp=data.20
IF edata.20>sysoplevel & name~=edname THEN line2=name' '
ELSE line2=''
IF num=21 & name=edname & edata.20<99 THEN LEAVE dummy
line=text.num':' data.num pen6'CHANGED TO'def temp
data.num=temp
SAY line
SAY
change=1
END
END
END
IF change THEN
DO
CALL SetData()
CALL saveData(1)
END
RETURN
getnumber:
PARSE ARG tprompt
tnum=getinput(1 0 ' 'tprompt' > ')
mask=COMPRESS(XRANGE(),'0123456789')
tnum=COMPRESS(tnum,mask)
IF ~DATATYPE(tnum,'W') THEN tnum=0
tnum=tnum%1
IF tnum>0 & tnum<10 THEN tnum='0'tnum
RETURN tnum
getbirth:
data.12=WORD(data.12,1)' 'WORD(data.12,2)' Birthday:'
SAY pen3'Please enter your birthday.'def
month=getnumber('month: (1-12)')
day=getnumber(' day: (1-31)')
year=getnumber(' year: ')
IF year<100 THEN year=year+1900
born=year||month||day
IF born<18750101 | born>(DATE('S')-50000) THEN
DO
born=''
IF getinput(1 1 'Would you rather skip this question? (Ny) > ')~='Y' THEN
CALL getbirth()
END
data.12=WORD(data.12,1)' 'WORD(data.12,2)' 'WORD(data.12,3)' 'WORD(born,1)
RETURN
getname:
CALL showuserlist()
SAY
pline='Please enter your full Email name : '
name=getinput(1 0 pline)
IF name='' THEN
DO
SAY 'No name, no entry. Bye!'
SIGNAL DONE
END
name=cleanstring(1':'name)
name=COMPRESS(name,':/*#?^')
IF FIND(userlist,name)>0 | FIND(exclusion,name)>0 THEN
DO
SAY 'Sorry! That name is taken. Please try again.'
RETURN 1
END
RETURN 0
/** see if name is in data */
checkUser:
tries=0
IF name='NEW' THEN
DO
name=''
DO WHILE getname()
END
END
IF FIND(userlist,name)=0 THEN
DO
IF EXISTS(bbspath'BBS_TEXT/NEW') THEN
DO
nonstop=0
CALL readlines(bbspath'BBS_TEXT/NEW' 1)
CALL seelines(0)
CALL waiting()
END
SAY
defile=bbspath'BBS_TEXT/DEF.NEW_USER'
CALL loadcourtesy()
wordnum=FIND(courtesy,name)
IF wordnum>0 THEN
DO
SAY name', is on the Courtesy List. You will be granted immediate access.'
courtesy=STRIP(DELWORD(courtesy,wordnum,1))
IF writeopen(bbspath'Lists/Courtesy') THEN
DO
DO i=1 TO WORDS(courtesy)
CALL WRITELN(f,WORD(courtesy,i))
END
CALL CLOSE(f)
END
defile=bbspath'BBS_TEXT/DEF.COURTESY'
END
ELSE IF bbsprefs.7=0 THEN SAY name', You have new user access.'
IF readlines(defile 1) THEN SIGNAL DONE
data.=''
data.0=24
DO i=6 TO 22
data.i=lynes.i
END
data.12=DATE('S')' 'TIME('C')
data.13=data.12
lastondate=DATE('I')-1
lastontime=TIME('C')
SAY 'Please enter the password you would like to use here.'
data.5=getinput(1 0 'Password:
')
IF data.5='' THEN
DO
line=''name 'refused to enter a password.'
SIGNAL DONE
END
data.1=''
DO WHILE data.1=''
data.1=getinput(0 0 'Full Name: ')
IF data.1='' THEN SAY 'You MUST leave your real name!'
END
data.2=getinput(0 0 'Street: ')
data.3=getinput(0 0 'City, State Zip: ')
data.4=''
DO WHILE data.4=''
data.4=getinput(0 0 'Phone: ')
IF data.4='' THEN
SAY sysop 'MUST be able to reach you by phone to validate you!'
END
CALL getbirth()
IF bbsprefs.8 THEN
DO
newufile=bbspath'Lists/NEW_USERS'
IF EXISTS(newufile) THEN ok=OPEN(f,newufile,'A')
ELSE
DO
ok=OPEN(f,newufile,'W')
IF ok~=0 THEN CALL WRITELN(f,'*** New Users ***')
END
IF ok~=0 THEN
DO
temp=RIGHT(TIME('C'),7) COMPRESS(DATE())
temp=temp LEFT(name,24)'=' data.1 data.4
CALL WRITELN(f,temp)
END
CALL CLOSE(f)
END
data.9=getinput(0 0 'Computer: ')
data.10=getinput(0 0 'Interests: ')
test=getinput(1 1 pen3'Do you want other users to see your STREET address? (Ny) > 'def)
IF test='Y' THEN data.8=data.8 'STREET'
test=getinput(1 1 pen3'Do you want other users to see your PHONE number? (Ny) > 'def)
IF test='Y' THEN data.8=data.8 'PHONE'
IF bbsprefs.7>0 THEN
DO
data.20=bbsprefs.7
data.11='60 minutes' bbsprefs.16-1 'more times today'
END
SAY
CALL SetData()
IF data.20=0 THEN
SAY 'Thank you, the sysop will give you higher access soon.'
ELSE IF bbsprefs.25=1 THEN
DO
data.22=''
data.23=''
SAY
SAY 'Setting message counters to last 10 messages in each conference...'
DO i=1 TO level
num=countcheck(bbspath'Numbers/LastMessage'i 0)-10
IF num<0 | msg.i.0<10 THEN num=0
lastread.i=num
data.22=data.22 num
data.23=data.23 0
END
SAY 'Setting file counter to last file uploaded...'
lastbrowse=countcheck(bbspath'Numbers/LastFile' 0)
newfilesdate='19900101 00:00:00'
END
SAY
SAY 'Please feel free to leave additional info by using [C]omment.'
SAY
CALL saveData(1)
SAY 'Adding' name 'to the user list...'
newpassword=data.5
sortuserflag=1
temp=countcheck(bbspath'Numbers/Users' 0)+1
CALL countcheck(bbspath'Numbers/Users' temp)
CALL DELETE(bbspath'Lists/USERS')
END
ELSE
DO
IF loadData()=0 THEN SIGNAL DONE
PARSE VAR data.11 amins . atimes .
lastondate=DATE('I',WORD(data.13,1),'S')
lastontime=WORD(data.13,2)
IF DATE('I')>lastondate | level>=sysoplevel THEN atimes=bbsprefs.16
IF level=99 THEN amins=120
data.13=DATE('S')' 'TIME()
data.11=amins 'minutes' atimes-1 'more times today'
passprompt='Enter Password:
'
DO tries=1 TO 3
OPTIONS PROMPT passprompt
PULL newpassword
SAY ''
IF(password=newpassword) THEN LEAVE tries; /* correct password */
IF tries=3 THEN
DO
SAY
SAY 'Access terminated.'
line='*** Bad password ***' newpassword '***'
SAY line
SIGNAL OUT2
END
SAY lineup' '
passprompt='Incorrect. Password: ' /* ask again */
END
END
CALL DELAY(14)
SAY
RETURN
saveData:
ARG messflag .
IF data.5='' THEN RETURN
SAY 'Updating... 'lineup
IF newfilesdate~='' THEN data.16=lastbrowse newfilesdate
ELSE IF lastbrowse>0 THEN
DO
IF WORDS(data.16)>1 THEN data.16=DELWORD(data.16,1,1)
ELSE data.16=DATE('S') TIME()
data.16=lastbrowse data.16
END
IF messflag THEN
DO
userexclude.=0
DO si=1 TO WORDS(data.22)
IF WORD(data.22,si)=-1 THEN userexclude.si=1
END
data.22=''
data.23=''
DO si=1 TO 99
IF ~DATATYPE(lastread.si,'W') THEN lastread.si=0
IF userexclude.si THEN data.22=data.22 '-1'
ELSE data.22=data.22 lastread.si
IF ~DATATYPE(totwrit.si,'W') THEN totwrit.si=0
data.23=data.23 totwrit.si
END
END
IF writeopen(bbspath'USERS/'name)=0 THEN RETURN
IF data.0<27 THEN data.0=27
DO i=1 TO data.0
CALL WRITELN(f,data.i)
END
CALL CLOSE(f)
SAY 'User' name 'has been updated.'
RETURN
loadData:
IF name='' THEN RETURN 0
IF ~readopen(bbspath'USERS/'name) THEN RETURN 0
data.=''
DO i=1
line=READLN(f)
IF EOF(f) THEN BREAK
data.i=line
END
data.0=i-1
CALL CLOSE(f)
winnings=WORD(data.18,1)
IF ~DATATYPE(winnings,'N') THEN winnings=0
setData:
IF WORDS(data.16)<3 THEN data.16='0 19900101 00:00:00'
lastbrowse=WORD(data.16,1)
IF ~DATATYPE(lastbrowse,'W') THEN lastbrowse=0
level=data.20
DO i=1 TO level
lastread.i=WORD(data.22,i)
IF ~DATATYPE(lastread.i,'W') THEN lastread.i=0
totwrit.i=WORD(data.23,i)
IF ~DATATYPE(totwrit.i,'W') THEN totwrit.i=0
END
password=data.5
IF ~DATATYPE(data.7,'W') THEN data.7=20
IF data.7<5 THEN data.7=5
IF FIND(UPPER(data.8),'TERSE')>0 THEN terseflag=1
ELSE terseflag=0
IF FIND(UPPER(data.8),'COLOR')>0 THEN colorflag=1
ELSE colorflag=0
CALL colors(colorflag)
menu='ALL'
IF FIND(UPPER(data.8),'MENUS')>0 THEN
DO
menuflag=1
menu='MAIN'
END
ELSE IF FIND(UPPER(data.8),'MENU')>0 THEN menuflag=1
ELSE menuflag=0
IF level=0 THEN menu='NEW'
data.21=UPPER(data.21)
maxtime=WORD(data.11,1)*60
loadFriends:
CALL MAKEDIR(bbspath'Friends')
alias.=''
alias.0=0
realname.=''
CALL CLOSE(f)
IF OPEN(f,bbspath'Friends/'name,'R')=0 THEN RETURN 1
DO i=1
line=READLN(f)
IF EOF(f) THEN LEAVE i
alias.i=WORD(line,1)
realname.i=WORD(line,2)
END
alias.0=i-1
CALL CLOSE(f)
RETURN 1
switchmenuflag:
IF menuflag=1 THEN
DO
menuflag=0
noff='OFF'
END
ELSE
DO
menuflag=1
noff='ON'
END
SAY 'Menus turned' pen3||noff||def'.'
SAY 'To make a permanent change, add or delete MENU(S) from [Y]our userdata item 8.'
RETURN
switchcolors:
IF colorflag=1 THEN
DO
colorflag=0
noff='OFF'
END
ELSE
DO
colorflag=1
noff='ON'
END
CALL colors(colorflag)
SAY 'Color turned' pen3||noff||def'.'
SAY 'To make a permanent change, add or delete COLOR from [Y]our userdata item 8.'
RETURN
/* ANSI pen color codes */
colors:
ARG onoff
IF onoff THEN
DO
lineup='1B'x'M'
def=''; /* default */
pen0='
'; pen1='
'; pen2='
'; pen3='
'
pen4='
'; pen5='
'; pen6='
'; pen7='
'
bak0='
'; bak1='
'; bak2='
'; bak3='
'
bak4='
'; bak5='
'; bak6='
'; bak7='
'
END
ELSE
DO
pen0=''; pen1=''; pen2=''; pen3=''; pen4=''; pen5=''; pen6=''; pen7=''
bak0=''; bak1=''; bak2=''; bak3=''; bak4=''; bak5=''; bak6=''; bak7=''
def=''; lineup=''
END
RETURN
sortinfofiles:
infolist=SHOWDIR(bbspath'Information')
IF infolist='' THEN
DO
SAY
SAY pen3'No files are currently in the Information drawer.'def
SAY
RETURN 1
END
IF ~DATATYPE(sortinfo.0,'W') THEN
DO
info.=''
sortinfo.=''
info.0=WORDS(infolist)
DO i=1 TO info.0
info.i=WORD(infolist,i)
END
SAY 'Sorting..'
CALL QSORT(1,info.0,info)
sortinfo.0=info.0%3
IF (info.0//3)>0 THEN sortinfo.0=sortinfo.0+1
DO i=1 TO sortinfo.0
sortinfo.i=''
DO j=0 TO 2
k=i+j*sortinfo.0
IF k<=info.0 THEN
DO
sortinfo.i=sortinfo.i RIGHT(k,3)'.' LEFT(info.k,19)
infocount=WORD(STATEF(bbspath'Information/'info.k),8)
sortinfo.i.0=sortinfo.i.0||RIGHT(infocount,5) LEFT(info.k,19)
END
END
END
SAY lineup' 'lineup
END
RETURN 0
information:
IF sortinfofiles() THEN RETURN
SAY pen3'These text files are available for reading online...'def
num=1
readcount=-1
DO infoloop=1
IF num=0 THEN
DO
IF readcount~=-1 THEN
DO
sortinfo.0=''
IF sortinfofiles() THEN RETURN
END
SAY CENTER('- Number of accesses per file -',75)
END
SAY pen3||LEFT('-',75,'-')||def
DO i=1 TO sortinfo.0
IF num=0 THEN SAY sortinfo.i.0
ELSE SAY sortinfo.i
END
IF num=0 THEN
DO
CALL waiting()
num=1
ITERATE infoloop
END
num=getinput(1 0 pen3'Select Number Of Information File To View. 0=Stats > 'def)
IF num=0 THEN ITERATE infoloop
IF ~DATATYPE(num,'W') | num<1 | num>info.0 THEN RETURN
readcount=STATEF(bbspath'Information/'info.num)
readbytes=WORD(readcount,2)
readcount=WORD(readcount,8)
IF ~DATATYPE(readcount,'W') THEN readcount=0
SAY ' 'info.num 'is' readbytes 'bytes.'
SAY 'Loading File...'
ADDRESS COMMAND 'C:filenote' bbspath'Information/'info.num readcount+1
CALL readlines(bbspath'Information/'info.num 1)
CALL cleanline(0)
SAY ' 'lynes.0 'lines.'
CALL seelines(0)
IF waitchar~='Q' THEN CALL waiting()
nonstop=0
END
RETURN
newfiles:
SAY
test=''
test=getinput(1 1 'Show one library only? (Ny) > ')
IF test='Y' THEN
IF chdir()>0 THEN RETURN
SAY 'Searching for new (un-browsed) files since' DATE(,WORD(data.16,2),'S') 'at' WORD(data.16,3)'...'
lastbrowz=WORD(data.16,1)
lastfileup=countcheck(bbspath'Numbers/LastFile' 0)
newfiles2:
IF lastbrowz>=lastfileup THEN
DO
lastbrowz=0
SAY pen3'No new files. Listing backwards by date from last file uploaded...'def
END
ELSE newfilesflag=1
j=0
IF test='Y' THEN
DO
filecount=WORDS(SHOWDIR(bbspath'FileNotes/'plaindir))
CALL busywait(4 1)
END
DO ni=lastfileup TO lastbrowz+1 BY -1
IF files.ni~='' THEN
DO
IF test='Y' THEN
DO
IF ni>1 THEN CALL busywait(60 ni lastfileup-lastbrowz)
IF j>=filecount THEN LEAVE ni
IF UPPER(LEFT(WORD(files.ni,1),12))~=UPPER(LEFT(plaindir,12)) THEN
ITERATE ni
END
jj=files.ni.0
IF WORD(alpha.jj,4)>level | FIND(data.21,UPPER(WORD(files.ni,1)))>0 THEN
ITERATE ni /* unauthorized */
IF test='Y' THEN CALL busywait(4 0)
j=j+1
IF j=1 THEN CALL fileheader()
SAY LEFT(alpha.jj,76)
IF (j+2)//(linesperpage-1)=0 THEN
IF waiting2() THEN LEAVE ni
IF test='Y' THEN CALL busywait(4 1)
END
END
IF test='Y' THEN CALL busywait(4 0)
IF j//linesperpage~=0 THEN CALL waiting()
IF j=0 & newfilesflag=1 THEN
DO
lastbrowz=999999
newfilesflag=0
CALL newfiles2()
END
IF test~='Y' THEN
DO
CALL newinfo()
IF lynes.0>0 THEN CALL waiting()
END
nonstop=0
RETURN
newinfo:
lynes.=''
lynes.0=0
dm=DATE(,WORD(data.16,2),'S')
PARSE VAR dm da' 'mo' 'yr .
yr=RIGHT(yr,2)
sincedate=da'-'mo'-'yr
startline=1
arg=bbspath'Information'
IF WORD(STATEF(arg),5)>lastondate THEN
DO
ADDRESS COMMAND 'C:LIST >ram:locdirlist' arg 'NOHEAD DATES SINCE' sincedate
IF WORD(STATEF('ram:locdirlist'),2)>3 THEN
DO
lynes.startline=pen1||bak2' New or Updated Information Files. Enter'def pen3'I'def bak2'from the main menu to read 'def
CALL readlines('ram:locdirlist' startline+1)
END
END
arg=bbspath'Profiles'
IF level>0 & WORD(STATEF(arg),5)>lastondate THEN
DO
ADDRESS COMMAND 'C:LIST >ram:locdirlist' arg 'NOHEAD DATES SINCE' sincedate
IF WORD(STATEF('ram:locdirlist'),2)>3 THEN
DO
startline=lynes.0+2
lynes.startline=pen1||bak2' New or Updated User Profiles. Enter'def pen3'&'def bak2'from the main menu to read 'def
CALL readlines('ram:locdirlist' startline+1)
END
END
arg=bbspath'rexxDoors/Data/Polls'
IF level>0 & WORD(STATEF(arg),5)>lastondate THEN
DO
startline=lynes.0+2
lynes.startline=pen1||bak2' Voting Activity. Enter'def pen3'J'def bak2'from the main menu, then select Polling_Place 'def
lynes.0=startline
END
IF logonflag=1 THEN nonstop=1
IF lynes.0>0 THEN CALL seelines(1)
nonstop=0
RETURN
areaselect:
SAY pen3||LEFT('-',75,'-')||def
DO i=1 TO msgs.0
SAY msgs.i
IF i//linesperpage=0 THEN CALL waiting()
END
temp=getinput(1 0 pen3'Select Message Conference: 'def)
IF ~DATATYPE(temp,'W') | temp<1 | temp>level | FIND(data.21,temp)>0 THEN RETURN 1
msgdir=temp
RETURN 0
chdir:
string=''
SAY pen3||LEFT('-',75,'-')||def
DO i=1 TO libs.0
SAY libs.i
END
dirnum=getinput(1 0 pen3'Select Library Number: 'def)
IF ~DATATYPE(dirnum,'W') THEN
DO
waitchar=dirnum
RETURN 2
END
chdir2:
IF dirnum<1 | dirnum>99 THEN
DO
waitchar=dirnum
RETURN 1
END
IF dirs.dirnum='' THEN
DO
SAY pen3'That library number is currently un-assigned.'def
RETURN 1
END
IF dirnum>level | FIND(data.21,UPPER(dirs.dirnum))>0 THEN
DO
SAY pen3'You do not have authorization for that library!'def
RETURN 1
END
CALL MAKEDIR(libpath||dirs.dirnum)
CALL setdir(libpath||dirs.dirnum)
t=libpath||plaindir'.txt'
IF ~EXISTS(t) THEN RETURN 0
nonstop=1
SAY
CALL readlines(t 1)
CALL seelines(1)
SAY
nonstop=0
RETURN 0
since:
dm=DATE(,WORD(data.16,2),'S')
SAY
SAY 'New files or files moved since' dm
CALL listsince()
CALL readlines('ram:locdirlist' 1)
CALL seelines(1)
nonstop=0
CALL waiting()
RETURN
listsince:
dm=DATE(,WORD(data.16,2),'S')
PARSE VAR dm da' 'mo' 'yr .
yr=RIGHT(yr,2)
sincedate=da'-'mo'-'yr
ADDRESS COMMAND 'C:list >ram:locdirlist' directory 'DATES SINCE' sincedate
RETURN
list:
onetime=0
IF DATATYPE(arg,'W') THEN onetime=1
ELSE arg=''
DO listloop=1
IF DATATYPE(arg,'W') THEN
DO
dirnum=arg
arg=''
IF chdir2()>0 THEN RETURN
CALL listsimple()
IF waitchar='Q' | onetime THEN LEAVE listloop
END
ELSE IF arg='' THEN
DO
IF chdir()>0 THEN RETURN
test='Y'
CALL showalpha2()
arg=''
IF waitchar='Q' THEN waitchar=''
IF waitchar~='' THEN RETURN
ITERATE listloop
END
ELSE RETURN
END
RETURN
listsimple:
ADDRESS COMMAND 'C:list >ram:locdirlist' directory 'DATES'
IF readlines('ram:locdirlist' 1) THEN RETURN
IF lynes.0>3 THEN
DO
SAY pen3'Sorting...'def||lineup
linesave=lynes.1 /* these 4 lines put in to leave dir title at top */
lynes.1='0'
CALL QSORT(1,lynes.0-1,lynes)
CALL DELAY(14)
lynes.1=linesave
END
CALL seelines(1)
nonstop=0
CALL waiting()
RETURN
browse:
curdironly=0
brdir=PRAGMA('D')
brfilenum=1
nonstop=0
IF files.0<1 THEN RETURN
lastfilenum=countcheck(bbspath'Numbers/LastFile' 0)
IF lastfilenum<1 THEN RETURN
onearg=0
IF arg='' THEN
DO
lin='Browsing'
test=getinput(1 1 'Browse one library only? (Ny) > ')
IF test='Y' THEN
DO
IF chdir()>0 THEN RETURN
curdironly=1
lin=lin 'the' pen3||plaindir||def 'library'
t=libpath||plaindir'.txt'
IF level>sysoplevel THEN
IF getinput(1 1 'Edit the'pen3 Plaindir def'library info file? (Ny) > ')='Y' THEN
DO
IF ~EXISTS(t) THEN
DO
IF writeopen(t)~=0 THEN
DO
CALL WRITELN(f,TRIM(CENTER('***' plaindir '***',77)))
CALL WRITELN(f,LEFT('',75,'='))
CALL CLOSE(f)
CALL DELAY(28)
END
END
CALL bbsED(1 t)
RETURN
END
END
ELSE lin=lin 'all file libraries'
lin=lin 'backwards from latest file.'
SAY lin
SAY
END
ELSE onearg=1
i=0
IF arg='' | UPPER(arg)='NEW' | UPPER(arg)='ALL' THEN
DO lastfileloop=1
IF lastfilenum<1 THEN RETURN
arg=WORD(files.lastfilenum,2)
brfilenum=lastfilenum
IF WORD(files.lastfilenum,2)~='' THEN LEAVE lastfileloop
lastfilenum=lastfilenum-1
END
ELSE IF DATATYPE(arg,'W') & files.arg~='' THEN
DO
brfilenum=arg
arg=WORD(files.arg,2)
IF arg='' THEN
DO
SAY 'File number' brfilenum 'does not exist in the current libraries!'
RETURN
END
END
ELSE
DO
IF onearg THEN CALL busywait(4 1)
DO ni=lastfilenum TO 1 BY -1
IF onearg THEN CALL busywait(60 ni lastfilenum)
IF UPPER(WORD(files.ni,2))~=UPPER(arg) THEN ITERATE ni
brfilenum=ni
CALL busywait(4 0)
LEAVE ni
END
IF ni<1 THEN
DO
SAY 'Unable to find a file description for' pen3||arg||def'.'
RETURN
END
END
IF ~curdironly THEN CALL setdir(libpath||WORD(files.brfilenum,1))
savearg=arg
IF brfilenum>lastfilenum THEN brfilenum=lastfilenum
newfilesdate=DATE('S') TIME()
DO browseloop=1
IF curdironly THEN CALL busywait(4 1)
DO ni=brfilenum TO 0 BY -1
IF ni=0 THEN LEAVE browseloop
IF files.ni='' THEN ITERATE ni
IF onearg THEN
DO
CALL busywait(60 ni lastfilenum)
IF UPPER(arg)=UPPER(WORD(files.ni,2)) THEN LEAVE ni
ELSE ITERATE ni
END
testdir=UPPER(WORD(files.ni,1))
IF curdironly & UPPER(plaindir)~=UPPER(testdir) THEN
DO
IF ni>lastbrowse THEN lastbrowse=ni
IF ni>0 THEN CALL busywait(60 ni lastfilenum)
ITERATE ni
END
IF FIND(data.21,testdir)>0 | finddirnum(testdir)>level THEN
DO
IF ni>lastbrowse THEN lastbrowse=ni
ITERATE ni
END
LEAVE ni
END
IF curdironly | onearg THEN CALL busywait(4 0)
onearg=0
IF ni=0 THEN brfilenum=lastbrowse
ELSE brfilenum=ni
argname=WORD(files.brfilenum,2)
IF argname='' THEN RETURN
CALL setdir(libpath||WORD(files.brfilenum,1))
arg=bbspath'FileNotes/'plaindir'/'argname
CALL readlines(arg 1)
IF nonstop=1 THEN brostop=1
ELSE brostop=0
CALL seelines(1)
IF brfilenum>lastbrowse THEN lastbrowse=brfilenum
IF brostop THEN
DO
SAY
nonstop=1
brfilenum=brfilenum-1
END
ELSE
DO
line=''
endtest=UPPER(RIGHT(argname,4))
IF FIND('.ARC .ARJ .DMS .LZH .LHA .RUN .ZIP .ZOO',endtest)>0 THEN
line='['pen3'C'def']ontents ['pen3'D'def']ownload'
ELSE line='['pen3'D'def']ownload'
IF level>sysoplevel | name=WORD(lynes.3,2) THEN
line=line '['pen3'E'def']dit'
IF level>sysoplevel | name=WORD(lynes.3,2) THEN
line=line '['pen3'K'def']ill'
IF level>sysoplevel THEN line=line '['pen3'L'def']ib'
line=line '['pen3'M'def']ark ['pen3'N'def']on-Stop'
IF endtest='.TXT' THEN line=line '['pen3'R'def']ead'
line=line '['pen3'Q'def']uit ['pen3'?'def'] > '
brcom=getinput(1 0 line)
IF DATATYPE(brcom,'W') THEN
DO
brfilenum=brcom+1
IF brfilenum>lastfilenum THEN brfilenum=lastfilenum+1
IF brfilenum<1 THEN brfilenum=1
SAY
END
ELSE brcom=LEFT(brcom,1)
CALL cleanline(0)
IF brcom='Q' THEN LEAVE browseloop
IF brcom='M' THEN
DO
wordnum=FIND(data.25,brfilenum)
IF wordnum=0 THEN
DO
data.25=STRIP(data.25 brfilenum)
SAY lineup||argname 'marked for next download.'
SAY
END
ELSE
DO
data.25=STRIP(DELWORD(data.25,wordnum,1))
SAY argname 'removed from download list.'
END
END
IF brcom='H' | brcom='?' THEN
DO
SAY pen3' - HELP with the Browse Files commands -'def
SAY ' RETURN reads the next file description in line.'
SAY ' 34 will display the description of file number 34, if it exists.'
SAY ' C displays the contents of an archived (arc dms lzh lha zip zoo) file.'
SAY ' D displays the download menu.'
IF level>sysoplevel | name=WORD(lynes.3,2) THEN
DO
SAY ' E puts this file description into the online Editor.'
SAY ' K deletes a file you uploaded. you cannot Kill others!'
END
IF level>sysoplevel THEN
SAY ' L move file and description to new Library and/or rename.'
SAY ' M mark/unmark the current file for the next download'
SAY ' N displays all descriptions without pausing. CTRL-E to Exit!'
SAY ' R displays file as text. - ONLY FILES THAT END IN .TXT -'
SAY ' Q returns to the main menu(s). (Quit)'
SAY
CALL waiting()
IF waitchar='Q' THEN LEAVE browseloop
END
ELSE IF brcom='L' & level>sysoplevel THEN
DO
curdir=PRAGMA('D')
IF getinput(1 1 'Rename' argname '? (Ny) > ')='Y' THEN
DO
newarg=getinput(0 0 'Rename' argname 'to ')
IF newarg~='' THEN
DO
IF is_here(newarg) THEN ITERATE browseloop
IF wi=999999 THEN ITERATE browseloop
IF EXISTS(libpath||filedir'/'newarg) THEN
DO
SAY
SAY '***' newarg 'already exists!'
SAY
ITERATE browseloop
END
junk=getinput(1 1 'Are you SURE you want to rename' argname 'to' newarg'? (Ny) ')
IF junk='Y' THEN
DO
lynes.2=OVERLAY(newarg,lynes.2,7,25)
comment=WORD(STATEF(arg),8)
CALL DELETE(arg)
arg=bbspath'FileNotes/'plaindir'/'newarg
CALL savelines(arg)
IF comment='' THEN
DO
mpath=libpath||plaindir
IF RENAME(mpath'/'argname,mpath'/'newarg)=0 THEN
SAY 'Rename failed on main file!'
END
ELSE
DO
t=LASTPOS('/',comment)
IF t=0 THEN t=LASTPOS(':',comment)
mpath=LEFT(comment,t-1)
IF RENAME(comment,mpath'/'newarg)=1 THEN
ADDRESS COMMAND 'C:FileNote' arg mpath'/'newarg
ELSE SAY 'Rename failed on external file!'
END
files.brfilenum=STRIP(WORD(files.brfilenum,1)) newarg
anum=files.brfilenum.0
alpha.anum=OVERLAY(newarg,alpha.anum,1,WORDINDEX(alpha.anum,2)-2)
argname=newarg
sortalphaflag=1
savefileflag=1
END
END
END
mvdir=getinput(0 0 'Move' argname 'to Library (name|number) ')
IF mvdir~='' THEN
DO
IF DATATYPE(mvdir,'W') THEN
DO
dirnum=mvdir
IF UPPER(dirs.dirnum)~=UPPER(WORD(files.brfilenum,1)) THEN
DO
IF chdir2()=0 THEN
DO
CALL readlines(arg 1)
CALL movefile(brfilenum dirs.dirnum)
END
END
END
ELSE
DO
mvdir=STRIP(mvdir)
IF UPPER(mvdir)~=UPPER(WORD(files.brfilenum,1)) THEN
DO
DO mj=1 TO level+1
IF UPPER(mvdir)=UPPER(dirs.mj) THEN LEAVE mj
END
IF mj<=level THEN CALL movefile(brfilenum mvdir)
END
END
END
IF savefileflag>0 THEN CALL savefilelist()
CALL setdir(curdir)
END
ELSE IF brcom='N' THEN
DO
brfilenum=brfilenum-1
nonstop=1
SAY pen3'To EXIT non-stop scrolling of text, press CTRL-E'def
SAY
CALL DELAY(100)
brcom=''
END
ELSE IF brcom='C' THEN
DO
temp=STRIP(WORD(STATEF(arg),8))
IF temp='' THEN temp=libpath||plaindir'/'argname
CALL Contents.rexx(temp)
IF EXISTS('RAM:CONTENTS') THEN
DO
CALL readlines('RAM:CONTENTS' 1)
CALL seelines(0)
IF waitchar~='Q' THEN CALL waiting()
nonstop=0
END
ELSE SAY pen3'Not an archived file.'def
END
ELSE IF brcom='D' THEN
DO
arg2=arg
arg=brfilenum
CALL dload()
arg=arg2
END
ELSE IF brcom='E' THEN
DO
IF level>sysoplevel | name=WORD(lynes.3,2) THEN
DO
firstedit=5
IF level>sysoplevel THEN firstedit=1
CALL bbsED(firstedit arg)
END
END
ELSE IF brcom='K' THEN
DO
IF level>sysoplevel | name=WORD(lynes.3,2) THEN
DO
IF getinput(1 1 pen3'Do you really want to kill this file? (nY) >'def)~='N' THEN
DO
tempnum=WORD(lynes.1,2)
IF tempnum=lastfilenum THEN
DO
CALL DELETE(bbspath'Numbers/LastFile')
CALL DELAY(28)
lastfilenum=lastfilenum-1
CALL countcheck(bbspath'Numbers/LastFile' lastfilenum)
END
files.tempnum=''
tempnum2=files.tempnum.0
alpha.tempnum2='0 0' tempnum '100'
CALL savefilelist()
finfo=STATEF(arg)
IF WORDS(finfo)>7 THEN argname=WORD(finfo,8)
CALL DELETE(argname)
CALL DELETE(arg)
SAY argname pen3'has been deleted.'def
END
END
END
ELSE IF brcom='R' & endtest='.TXT' THEN
DO
vcount=WORD(lynes.2,7)+1
lynes.2=STRIP(DELWORD(lynes.2,7,1)) vcount
edtype=''
CALL savelines(arg)
CALL showtext(argname)
END
ELSE brfilenum=brfilenum-1
END
END
CALL setdir(brdir)
waitchar=''
IF nonstop THEN CALL waiting()
nonstop=0
CALL savedata(0)
RETURN
movefile:
PARSE ARG fnum movdir .
fromdir=STRIP(WORD(files.fnum,1))
farg=STRIP(WORD(files.fnum,2))
CALL MAKEDIR(libpath||movdir)
ADDRESS COMMAND 'C:COPY' libpath||fromdir'/'farg libpath||movdir
IF EXISTS(libpath||movdir'/'farg) THEN CALL DELETE(libpath||fromdir'/'farg)
files.fnum=movdir farg
lynes.3=DELWORD(lynes.3,WORDS(lynes.3),1)
lynes.3=STRIP(lynes.3) movdir
CALL MAKEDIR(bbspath'FileNotes/'movdir)
CALL savelines(bbspath'FileNotes/'movdir'/'farg)
ndx=files.fnum.0
dnum=finddirnum(movdir)
alpha.ndx=OVERLAY(RIGHT(dnum,2) movdir,alpha.ndx,31,15)
IF EXISTS(bbspath'FileNotes/'movdir'/'farg) THEN
DO
temp=bbspath'FileNotes/'fromdir'/'farg
comment=WORD(STATEF(temp),8)
CALL DELETE(temp)
IF comment~='' THEN
ADDRESS COMMAND 'C:FileNote' bbspath'FileNotes/'movdir'/'farg comment
END
savefileflag=1
line='Moved:' fromdir'/'farg 'to' movdir
SAY line
RETURN
textsearch:
PARSE ARG sfile' 'sarg
IF sarg='' THEN RETURN 0
x=OPEN(f,sfile,'R')
IF x=0 THEN RETURN 0
sarg=UPPER(sarg)
stemp=UPPER(READCH(f,65000))
CALL CLOSE(f)
retflag=0
IF POS(sarg,stemp)>0 THEN retflag=1
DROP stemp
RETURN retflag
bbsSEARCH:
smenu=menu
test=UPPER(LEFT(arg,1))
IF test='F' THEN smenu='FILE'
IF test='M' THEN smenu='MSG'
IF test='U' THEN smenu='MAIN'
IF smenu='ALL' THEN
DO
junk=getinput(1 1 'Search ['pen3'F'def']iles ['pen3'M'def']essages or ['pen3'U'def']sers (fmu) > ')
IF junk='F' THEN smenu='FILE'
ELSE IF junk='M' THEN smenu='MSG'
ELSE IF junk='U' THEN smenu='MAIN'
ELSE RETURN
END
IF WORDS(arg)>1 THEN searcharg=UPPER(SUBSTR(arg,WORDINDEX(arg,2)))
ELSE searcharg=getinput(0 0 pen3'Search Phrase: 'def)
IF LENGTH(STRIP(searcharg))=0 THEN RETURN
searcharg=COMPRESS(searcharg,'*')
IF smenu='NEW' | smenu='MAIN' THEN
DO
SAY 'Searching Userlist...'
DO i=1 TO WORDS(userlist)
IF POS(UPPER(searcharg),UPPER(WORD(userlist,i)))>0 THEN
SAY WORD(userlist,i)
END
END
IF smenu='MSG' THEN
DO
IF getinput(1 1 'Search one conference only? (Ny) > ')='Y' THEN
DO
IF areaselect() THEN RETURN
SAY 'Searching' msg.msgdir 'Message Conference for'pen3 searcharg||def'...'
SAY
CALL searchmsgdir()
END
ELSE
DO
SAY 'Searching All Public Message Conferences for'pen3 searcharg||def'...'
SAY
DO i=1 TO level
msgdir=i
IF msg.msgdir='' | FIND(data.21,msgdir)>0 THEN ITERATE i
CALL searchmsgdir()
i=msgdir
IF msgcom='Q' THEN i=999999
END
END
END
IF smenu='FILE' THEN
DO
line=pen3'Searching'
curdironly=0
IF getinput(1 1 'Search one library only? (Ny) > ')='Y' THEN
DO
IF chdir()>0 THEN RETURN
curdironly=1
line=line 'the' pen3||plaindir||def 'library'
SAY
END
ELSE
DO
line=line 'all file libraries'
SAY
SAY pen3'WARNING!'def 'Searching' RIGHT(files.0,5) '['pen3'F'def']ull descriptions may take'pen3 TRUNC(files.0/(114*cpu)+.05,1) def'minutes!'
END
test=getinput(1 1 ' ['pen3'A'def']lphaList search or ['pen3'F'def']ull descriptions? (Afq) > ')
IF test='Q' THEN RETURN
SAY
SAY line 'for'def UPPER(searcharg)
SAY pen3' - To ABORT, press CTRL-E -'def
SAY
IF test~='F' THEN
DO
CALL fileheader()
DO i=1 TO alpha.0
CALL busywait(60 i alpha.0)
ii=WORD(alpha.i,4)
IF ii>level THEN ITERATE i
IF curdironly=1 & ii~=dirnum THEN ITERATE i
ii=WORD(alpha.i,3)
IF POS(UPPER(WORD(files.ii,1)),data.21)>0 THEN ITERATE i
tempnum=POS(UPPER(searcharg),UPPER(alpha.i))
IF tempnum>0 THEN
DO
CALL busywait(4 0)
SAY alpha.i
IF colorflag=1 THEN
SAY pen3||LEFT(' ',tempnum-1)||lineup||UPPER(searcharg)||def
CALL busywait(4 1)
END
END
END
ELSE
DO
cck=countcheck(bbspath'Numbers/LastFile' 0)
nonstop=1
DO i=1 TO cck
iii=cck+1-i
IF files.iii='' THEN ITERATE i
ii=files.iii.0
ii=WORD(alpha.ii,4)
IF ii>level THEN ITERATE i
IF curdironly=1 & ii~=dirnum THEN ITERATE i
IF POS(UPPER(WORD(files.iii,1)),data.21)>0 THEN ITERATE i
farg=WORD(files.iii,1)'/'WORD(files.iii,2)
SAY '1B'x'M' RIGHT(farg,40) LEFT(iii,7)
IF textsearch(bbspath'FileNotes/'farg searcharg) THEN
DO
savei=i
CALL readlines(bbspath'FileNotes/'farg 1)
CALL seelines(2)
i=savei
SAY
SAY
END
END
END
CALL busywait(4 0)
END
searcharg=''
nonstop=0
SAY
IF i<999999 THEN SAY 'All available items have been searched.'
SAY
CALL waiting()
RETURN
searchmsgdir:
msglist=SHOWDIR(msgpath||msgdir)
IF WORDS(msglist)>0 THEN SAY lineup||RIGHT(msg.msgdir,40)
qi=WORDS(msglist)
DO wi=1 TO qi
CALL busywait(8 wi qi)
messnum=WORD(msglist,wi)%1
IF textsearch(msgpath||msgdir'/'messnum searcharg) THEN
DO
CALL busywait(4 0)
savelast=lastread.msgdir
CALL readmsg(0 messnum)
lastread.msgdir=savelast
IF msgcom='Q' THEN RETURN
CALL busywait(4 1)
END
END
CALL busywait(4 0)
RETURN
finddirnum:
ARG fdirname .
DO fdir=1 TO 99
IF UPPER(dirs.fdir)=UPPER(fdirname) THEN RETURN fdir
END
RETURN 100
writebuffer:
PARSE ARG bufname .
CALL DELETE(bufname)
startnum=lynes.0+1
OPTIONS PROMPT ''
SAY pen3'LOCAL logon! Input cannot exceed 250 characters per line!'def
SAY 'Type 'pen3'/E'def 'or' pen3'/S'def' on a new line to exit and' pen3'DO YOUR OWN WORDWRAP!'def
DO bufloop=startnum
PARSE PULL line
IF LEFT(UPPER(STRIP(line)),2)='/E' | LEFT(UPPER(STRIP(line)),2)='/S' THEN
LEAVE bufloop
lynes.bufloop=line
END
lynes.0=bufloop-1
CALL wrapbuf(startnum)
CALL DELETE(bufname) /* these 4 lines make wordwrap more consistent */
CALL savelines(bufname)
CALL readlines(bufname 1)
CALL wrapbuf(startnum)
RETURN
wrapbuf:
ARG startnum .
CALL cleanline(1)
SAY pen3'Wordwrapping...'def
lynes.startnum=TRANSLATE(lynes.startnum,' ','09'x)
lynes.startnum=COMPRESS(lynes.startnum,'0C'x) /* no FF */
DO wi=startnum WHILE wi<=lynes.0
wj=wi+1
lynes.wj=COMPRESS(lynes.wj,'08'x||'0C'x||'7F'x)
tabpos=POS('09'x,lynes.wi)
DO WHILE tabpos>0
lynes.wi=DELSTR(lynes.wi,tabpos,1)
lynes.wi=INSERT(' ',lynes.wi,tabpos-1)
tabpos=POS('09'x,lynes.wi)
END
IF LENGTH(lynes.wi)>75 THEN
DO
testchar=''
IF lynes.wj~='' THEN testchar=LEFT(lynes.wj,1)
IF testchar=' ' | testchar='.' | testchar=':' THEN
DO
DO wjj=lynes.0 TO wi+1 BY -1
wk=wjj+1
lynes.wk=lynes.wjj
END
lynes.wj=''
lynes.0=lynes.0+1
END
DO wl=WORDS(lynes.wi) TO 1 BY -1 WHILE LENGTH(lynes.wi)>74
IF WORDS(lynes.wi)=1 THEN
lynes.wi=LEFT(lynes.wi,74) SUBSTR(lynes.wi,75)
lynes.wj=WORD(lynes.wi,wl) lynes.wj
lynes.wi=STRIP(DELWORD(lynes.wi,wl,1))
END
END
END
RETURN
seelines:
ARG fancy .
DO i=1 TO lynes.0
IF fancy=0 THEN SAY lynes.i||def
ELSE
DO
IF LEFT(lynes.i,2)=': ' & WORDS(lynes.i)=2 THEN ITERATE i
ELSE IF LEFT(lynes.i,10)='Directory ' | LEFT(lynes.i,5)='=====' THEN
SAY pen3||lynes.i||def
ELSE SAY lynes.i
IF fancy=2 & colorflag=1 & searcharg~='' THEN
DO
testpos=POS(UPPER(searcharg),UPPER(lynes.i))
IF testpos>0 THEN
SAY LEFT(' ',testpos-1)||pen3||lineup||UPPER(searcharg)||def
END
END
IF i//linesperpage=0 THEN
IF waiting2() THEN LEAVE i
END
nonstop=0
RETURN
readlines:
CALL CLOSE(f)
PARSE ARG tempname readstart .
IF ~readopen(tempname) THEN RETURN 1
IF readstart<2 THEN lynes.=''
DO ri=readstart
line=READLN(f)
IF EOF(f) THEN BREAK
lynes.ri=line
END
lynes.0=ri-1
CALL CLOSE(f)
DO ri=lynes.0 TO 0 BY -1 WHILE LENGTH(lynes.ri)=0 | LEFT(UPPER(lynes.ri),2)='/E' | LEFT(UPPER(lynes.ri),2)='/S'
END
lynes.0=ri
RETURN 0
savelines:
PARSE ARG tempname .
IF EXISTS(tempname) & edtype='MAIL' THEN
DO
ok=OPEN(f,tempname,'A')
IF ok~=0 THEN CALL WRITELN(f,LEFT('',74,'^'))
END
ELSE ok=OPEN(f,tempname,'W')
IF ok=0 THEN
DO
line='***' tempname 'failed to open for saving!'
SAY line
RETURN 1
END
DO wi=1 TO lynes.0
CALL WRITELN(f,lynes.wi)
END
CALL CLOSE(f)
RETURN 0
loaduserlist:
userlist=SHOWDIR(bbspath'Users')
ulynes.=''
IF ~EXISTS(bbspath'Lists/USERS') THEN CALL sortuserlist()
ELSE IF readopen(bbspath'Lists/USERS') THEN
DO
SAY 'Loading Userlist...'
DO lui=1
line=READLN(f)
IF EOF(f) THEN BREAK
ulynes.lui=line
END
ulynes.0=lui-1
CALL CLOSE(f)
END
RETURN
saveuserlist:
SIGNAL OFF BREAK_E
IF writeopen(bbspath'Lists/USERS') THEN
DO
DO i=1 TO ulynes.0
CALL WRITELN(f,ulynes.i)
END
CALL CLOSE(f)
END
RETURN
sortuserlist:
SAY 'Rebuilding Userlist...'
sortuserflag=0
userlist=SHOWDIR(bbspath'Users')
user.=''
users=WORDS(userlist)
user.0=users
DO uli=1 TO users
user.uli=WORD(userlist,uli)
uscore=LASTPOS('_',user.uli)
IF uscore>0 THEN user.uli=SUBSTR(user.uli,uscore+1)'@'LEFT(user.uli,uscore-1)
END
CALL QSORT(1,users,user)
DO uli=1 TO users
uscore=POS('@',user.uli)
IF uscore>0 THEN user.uli=SUBSTR(user.uli,uscore+1)'_'LEFT(user.uli,uscore-1)
END
ulynes.=''
ulynes.0=user.0%3
IF (user.0//3)>0 THEN ulynes.0=ulynes.0+1
DO i=1 TO ulynes.0
ulynes.i=LEFT(user.i,25)
DO j=1 TO 2
k=i+j*ulynes.0
IF k<=users THEN ulynes.i=ulynes.i' 'LEFT(user.k,25)
END
END
CALL saveuserlist()
RETURN
showuserlist:
IF data.5='' THEN line='Here are the EMail names of your fellow users.'
ELSE line=' 'WORDS(userlist) 'users. Use these names to address messages.'
SAY pen3||line||def
DO uli=1 TO ulynes.0
SAY ulynes.uli
IF uli//linesperpage=0 & uli<ulynes.0 THEN
IF waiting2()=1 THEN RETURN
END
IF data.5~='' THEN CALL waiting()
RETURN
msgcount:
ARG countdir .
lastmess=0
totmsgs=0
unred=0
IF ~EXISTS(msgpath||countdir) THEN RETURN
IF STATEF(msgpath||countdir)=msg.countdir.1 THEN totmsgs=msg.countdir.0
ELSE
DO
totmsgs=WORDS(SHOWDIR(msgpath||countdir))
msg.countdir.0=totmsgs
msg.countdir.1=STATEF(msgpath||countdir)
END
IF countdir>level | FIND(data.21,i)>0 THEN RETURN
lastread.countdir=WORD(data.22,countdir)
IF ~DATATYPE(lastread.countdir,'W') THEN lastread.countdir=0
lastmess=countcheck(bbspath'Numbers/LastMessage'countdir 0)
IF lastread.countdir<0 THEN RETURN
firstmess=countcheck(bbspath'Numbers/FirstMessage'countdir 0)
IF lastread.countdir<firstmess THEN lastread.countdir=firstmess-1
IF lastmess>0 THEN
IF lastread.countdir>=0 THEN
DO
IF lastread.countdir<(firstmess-1) THEN lastread.countdir=firstmess-1
unred=lastmess-lastread.countdir
IF unred>totmsgs THEN unred=totmsgs
cline=RIGHT(unred,6) 'unread of' RIGHT(lastmess,6)
cline=cline 'messages in the 'CENTER(msg.countdir,20)' conference.'
IF unred>0 | ~logonflag THEN SAY pen6||cline||def
END
RETURN
counts:
SAY
SAY 'Working...'
SAY
temp=''
DO i=1 TO 4
temp=temp||CENTER(copyright.i,75)||'0A'x
END
CALL SETCLIP('BBS_copyright',temp)
IF emailonline<0 THEN CALL countmail()
CALL bbsSTATS.rexx(name colorflag 0 emailonline grand grand2 files.0 WORDS(userlist))
SAY
CALL waiting2()
IF waitchar='Q' THEN RETURN
CALL showmarked(1)
CALL logonstats()
nonstop=0
CALL waiting()
RETURN
countmail:
SAY ' Counting online email...'
emailonline=0
DO ti=1 TO WORDS(userlist)
emailonline=emailonline+WORDS(SHOWDIR(bbspath'Email/'WORD(userlist,ti)))
END
RETURN
hourly:
IF level=99 & nonstop~=1 THEN
DO
IF getinput(1 1 'Zero The Hourly Averages? (Ny) > ')='Y' THEN
ADDRESS COMMAND 'C:Delete >*' bbspath'Numbers/Hourly/#?'
CALL cleanline(1)
END
CALL ShowHourly.rexx(name linesperpage colorflag nonstop)
RETURN
logonstats:
IF level=0 THEN RETURN
SAY bak2||name||def 'Last on' DATE('W',lastondate,'I') DATE(,lastondate,'I') lastontime
tempnum=countcheck(bbspath'Numbers/LastFile' 0)-lastbrowse
IF tempnum>files.0 THEN tempnum=files.0
line='of' RIGHT(countcheck(bbspath'Numbers/LastFile' 0),6) 'public files uploaded.'
IF tempnum>0 THEN SAY RIGHT(tempnum,6) ' new of' RIGHT(files.0,6) 'files online 'line
ELSE SAY ' No new' line
totmsg=0
grand=0
grand2=0
DO i=1 TO 99
IF msg.i='' THEN ITERATE i
CALL msgcount(i)
totmsg=totmsg+unred
grand=grand+totmsgs
grand2=grand2+lastmess
END
line=RIGHT(grand2,6) 'public messages written'
IF totmsg>0 THEN
SAY RIGHT(totmsg,6) ' new of' line',' grand 'messages online.'
ELSE SAY ' No new of' line'.'
RETURN
readopen:
PARSE ARG fname
ok=OPEN(f,fname,'R')
IF ok~=0 THEN RETURN 1
line=fname 'failed to open for reading!'
SAY line
RETURN 0
writeopen:
PARSE ARG fname
CALL CLOSE(f)
ok=OPEN(f,fname,'W')
IF ok~=0 THEN RETURN 1
line=fname 'failed to open for writing!'
SAY line
RETURN 0
set_grand:
SAY 'Setting up public message conferences...'
grand=0
DO i=1 TO 99
IF msg.i='' THEN ITERATE i
msg.i.0=WORDS(SHOWDIR(msgpath||i,'F'))
msg.i.1=STATEF(msgpath||i)
grand=grand+msg.i.0
END
RETURN
SYNTAX:
FAILURE:
lin.1=pen7||ERRORTEXT(RC)||def
lin.2=SIGL-1 SOURCELINE(SIGL-1)
lin.3=SIGL pen7||SOURCELINE(SIGL)||def
lin.4=SIGL+1 SOURCELINE(SIGL+1)
DO er=1 TO 4
SAY lin.er
END
IF newpassword='' THEN SIGNAL DONE2 /* no user logged on, quit quietly */
CALL CLOSE(f)
IF level>sysoplevel THEN
DO
junk=getinput(1 1 'ReStart: (Ny) > ')
IF junk~='Y' THEN SIGNAL LOGOUT
END
string=''
waitchar=''
IF data.1~='' & data.5~='' & data.20~='' THEN CALL savedata(0)
SIGNAL RESTART
BREAK_E:
CALL CLOSE(f)
SAY pen3'*** CTRL-E BREAK ***'def
waitchar=''
string=''
nonstop=0
rnonstop=0
brostop=0
i=999999
wi=999999
ni=-1
RETURN 0
BREAK_C:
CALL CLOSE(f)
LOGOUT:
LOGOUT2:
secs=TIME('E')
mins=secs%60
secs=TRUNC(secs//60)
IF secs<10 THEN secs='0'secs
SAY
SAY 'Public messages now online: 'RIGHT(comma(grand),9)
SAY 'Public files now online: 'RIGHT(comma(files.0),9)
SAY
SAY 'Time used this call:' mins':'secs
SAY
arg=bbspath'BBS_TEXT/GOODBYE'
IF EXISTS(arg) THEN
DO
CALL DELAY(14)
CALL readlines(arg 1)
nonstop=1
CALL seelines(0)
nonstop=0
END
SAY
IF bbsprefs.2 THEN CALL doGrin()
SAY
CALL bbsLOGOFF.baud(name level 0)
OUT:
data.18=winnings
OUT2:
DONE:
DONE2:
IF newfilesflag=1 THEN
DO
newfilesdate=DATE('S') TIME()
lastbrowse=countcheck(bbspath'Numbers/LastFile' 0)
END
IF clear_marked=1 THEN data.24=''
CALL saveData(0)
IF EXISTS(bbspath'EmailFiles/'name'/QUICKIN.lha') THEN
ADDRESS AREXX bbsQUICKIN.rexx name level sysoplevel bbsprefs.6
IF sortuserflag=1 THEN
DO
CALL sortuserlist()
IF SHOW('P','BBBBS') THEN
DO
CALL SETCLIP('BBS_mainusers')
CALL SETCLIP('BBS_localusers',1)
END
sortuserflag=0
END
IF sortalphaflag>0 | savefileflag>0 THEN
DO
IF savefileflag>0 THEN CALL savefilelist2()
ELSE CALL savealphalist()
IF SHOW('P','BBBBS') THEN CALL SETCLIP('BBS_localfiles',2)
END
IF getinput(1 1 'Reset for next local user? (nY) > ')='N' THEN EXIT
clear_marked=0
data.=''
SIGNAL BIG_LOOP
checkclips:
IF GETCLIP('BBS_mainusers')~='' THEN
DO
CALL loaduserlist()
CALL SETCLIP('BBS_mainusers')
END
IF GETCLIP('BBS_mainfiles')~='' & GETCLIP('BBS_maint')='' THEN
DO
CALL SETCLIP('BBS_mainfiles')
CALL loadfiles()
CALL loadalpha()
END
RETURN
checkalias:
addressee=''
IF alias.0=0 THEN RETURN 0
DO i=1 TO alias.0
IF UPPER(alias.i)=UPPER(string) THEN
DO
addressee=realname.i
LEAVE i
END
END
IF addressee='' THEN RETURN 0
string=''
SAY pen3'Email to 'def||addressee
CALL editor('MAIL' addressee)
RETURN 0
Friends:
ch=''
aliasexclude='sysop bye off'
DO WHILE ch~='Q'
SAY
SAY pen3||LEFT('=',75,'=')def
SAY CENTER('F R I E N D S - L I S T',75)
SAY
SAY CENTER('A L I A S E D I T O R',75)
SAY pen3||LEFT('=',75,'=')def
SAY
SAY ' 'pen3'W - 'def'What is the Friends List? '
SAY ' 'pen3'A - 'def'Add an Alias '
SAY ' 'pen3'D - 'def'Delete an Alias '
SAY ' 'pen3'V - 'def'View my Aliases '
SAY ' 'pen3'Q - 'def'Return to Main Menu'
SAY
ch=getinput(1 1 pen3'Enter Choice > 'def)
SELECT
WHEN ch='W' THEN CALL whatFriends()
WHEN ch='A' THEN CALL addalias()
WHEN ch='D' THEN CALL delalias()
WHEN ch='V' THEN CALL viewalias()
WHEN ch='Q' THEN CALL saveFriends()
OTHERWISE SAY 'No such command'
END
END
string=''
RETURN
saveFriends:
frn=bbspath'Friends/'name
IF alias.0<1 THEN
DO
CALL DELETE(frn)
RETURN
END
CALL OPEN(f,frn,'W')
DO i=1 TO alias.0
CALL WRITELN(f,alias.i' 'realname.i)
END
CALL CLOSE(f)
RETURN
whatFriends:
CALL readlines(bbspath'Information/BBBBS.Friends' 1)
CALL cleanline(0)
CALL seelines(0)
IF waitchar~='Q' THEN CALL waiting()
nonstop=0
RETURN
addalias:
match=0
username=getinput(1 0 pen3'Enter Users Email Name > 'def)
username=cleanstring(1':'username)
IF username='' THEN RETURN
IF FIND(userlist,username)=0 THEN
DO
SAY 'Username not found'
RETURN
END
newalias=getinput(1 0 pen3'Enter an Alias for'def' 'username def'> ')
IF newalias='' THEN RETURN
IF alias.0>0 THEN
DO i=1 TO alias.0
IF UPPER(alias.i)=UPPER(newalias) THEN match=1
END
IF FIND(aliasexclude,newalias)>0 THEN match=2
IF match=0 THEN
DO
alias.0=alias.0+1
num=alias.0
alias.num=newalias
realname.num=username
SAY alias.num 'alias as ' realname.num 'added'
END
ELSE IF match=1 THEN SAY 'Alias 'newalias' already exists'
ELSE SAY newalias ' is a reserved name'
RETURN
delalias:
match=0
dalias=getinput(1 0 pen3'Enter Alias to Delete > 'def)
dalias=UPPER(WORD(dalias,1))
IF alias.0>0 THEN
DO i=1 TO alias.0
IF UPPER(alias.i)=UPPER(dalias) THEN
DO
match=1
num=i
LEAVE i
END
END
IF match=1 THEN
DO
IF getinput(1 1 'Really Delete 'dalias'? (Ny) > ')='Y' THEN
DO
DO i=num TO alias.0
j=i+1
alias.i=alias.j
realname.i=realname.j
END
alias.0=alias.0-1
END
END
ELSE SAY dalias' not Found.'
RETURN
viewalias:
IF alias.0>0 THEN
DO i=1 TO alias.0
SAY RIGHT(alias.i,20) 'is' realname.i
END
ELSE SAY 'No Aliases assigned'
RETURN
/* bbsLOCAL.rexx */
/* Userfile Data definitions */
1 name
2 address
3 city state country zip
4 telephone
5 password
6 protocol
7 lines per page
8 Preferences: MENUS COLOR STREET PHONE etc. On list=YES, ON or PUBLIC.
9 Computer model
10 interests ! SYSOP edit only below this line !
11 nn minutes n more times today (typically 60 mins 3 times/day).
12 first date on. timestamp Birthday: birthday
13 last date on BBS in 'S' form for rexx DATE().
14 uploaded files bytes lastdate
15 downloaded files bytes lastdate
16 lastfilebrowsed lastfilelistdate lastfilelisttime
17 ul:dl_ratio total_email_written last_email_read_(sysop only)
18 winnings
19 total time on this BBS in hours minutes calls
20 level
21 exclude dirs by name (conferences by number), separated by spaces.
22 oldest messages read
23 total msgs written per conference
24 Marked message list msgdirnum/msgnum
25 filenumbers to download (temporary)
26 QUICK exclude list
27 Call Back Verify Number(s)
/* end data defines */